Home‎ > ‎

Cambiar/Extraer Nombre de la Base de Datos Activa

 
Function NombreBD() As String
On Error GoTo err_NombreBD
'***************************************************************
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&               Jefferson Jimenez (JJJT)                     &*
'&                 Cabimas - Venezuela                        &*
'&                    Agosto - 2009                           &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'***************************************************************
'Funcion que devuelve el Nombre de la Base de datos sin la extension

Dim Ext2003, Ext2007 As Long
Dim db As Object 'DAO.Database
Ext = Right(CurrentProject.Name, _
      Len(CurrentProject.Name) - _
      InStrRev(CurrentProject.Name, ".")) 'Primero busco la extension
                                          ' del fichero
If Ext = "accdb" Or Ext = "accde" Then ' La Condicion si es A2007
        Ext2007 = Len(CurrentProject.Name) - 6 'Extraigo el nombre y le quito la extension
        NombreBD = Mid(CurrentProject.Name, 1, Ext2007) 'Le paso el nombre a la
        'funcion sin la extension
             Set db = CurrentDb                            '=
               db.Properties("AppTitle").value = NombreBD  '= Ya con esta funcion
                 db.Properties.Refresh                     '= Por aqui le paso el nombre
                 Application.RefreshTitleBar               '= de la base de datos, al
               Set db = Nothing                            '= titulo de la aplicacion
             Set db = CurrentDb                            '=
    Else
    'De no ser A2007.., Hago lo mismo
        Ext2003 = Len(CurrentProject.Name) - 4
        NombreBD = Mid(CurrentProject.Name, 1, Ext2003)
             Set db = CurrentDb
               db.Properties("AppTitle").value = NombreBD
                 db.Properties.Refresh
                 Application.RefreshTitleBar
               Set db = Nothing
             Set db = CurrentDb
  End If
'El tratamiento de errores de no existir el nombre en el titulo de la aplicacion
err_NombreBD:
    If Err.Number = 3270 Then 'Numero de error cuando la propiedad no existe
       Set vacio = db.CreateProperty("AppTitle", DB_TEXT, NombreBD)
                db.Properties.Append vacio
            Set vacio = Nothing
        End If
    Resume Next
'Fin de la funcion
End Function

SelectionFile type iconFile nameDescriptionSizeRevisionTimeUser
ċ

Descargar
Descarga El Ejemplo  46 kb v. 1 1 sept. 2009 8:07 Jefferson Jimenez
Comments