VBA version of http://www.devx.com/vb2themax/Tip/19608

GetDBNameFromConnString

Function GetDBNameFromConnString(ByVal connString As String) As String
    Dim lcConnString As String
    Dim endIndex As Integer
    
    lcConnString = LCase(connString)

    ' if this is a Jet database, find the index of the "data source" setting
    Dim startIndex As Integer
    If InStr(1, lcConnString, "jet.oledb", vbTextCompare) > -1 Then
        startIndex = InStr(1, lcConnString, "data source=", vbTextCompare)
        If startIndex > -1 Then startIndex = startIndex + 12
    Else
        ' if this is a SQL Server database, find the index of the "initial
        ' catalog" or "database" setting
        startIndex = InStr(1, lcConnString, "initial catalog=", vbTextCompare)
        If startIndex > -1 Then
            startIndex = startIndex + 16
        Else ' if the "Initial Catalog" setting is not found,
             '  try with "Database"
            startIndex = InStr(1, lcConnString, "database=", vbTextCompare)
            If startIndex > -1 Then startIndex = startIndex + 9
        End If
    End If

    ' if the "database", "data source" or "initial catalog" values are not
    ' found, return an empty string
    If startIndex = -1 Then GetDBNameFromConnString = "": Exit Function

    ' find where the database name/path ends
    endIndex = InStr(startIndex, lcConnString, ";", vbTextCompare)
    If endIndex = -1 Then endIndex = Len(lcConnString)

    ' return the substring with the database name/path
    GetDBNameFromConnString = Mid$(connString, startIndex, endIndex - startIndex)
End Function