Sub CheckDBName()
Dim m As String
Dim i As Integer
Dim i2 As Integer

On Error Resume Next
m = CurrentProject.Connection.ConnectionString
i = InStr(m, "Initial Catalog=")
i2 = InStr(m, ";Data Provider=")
m = Mid(CurrentProject.Connection.ConnectionString, (i + 16),
(i2 - (i + 16)))