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