MsgBox  "Sorry. The connection could not be opened." 

[color=red] Красный [/color]

Public Function cnnRemDataServerCursor() As ADODB.Connection
    On Error GoTo mis

    Dim tmpLng                     As Long
    Dim tmpStr                     As String
    Const cnnNameOfFileData        As String =  "data.mdb"     ' имя файла с данными
'tmpcnnRemDataServerCursor  - переменая As ADODB.Connection
    If Not (tmpcnnRemDataServerCursor Is Nothing) Then
        'если перемнная создана проверим на ее состояние
        Select Case tmpcnnRemDataServerCursor.state
            Case adStateOpen
                Set cnnRemDataServerCursor = tmpcnnRemDataServerCursor
                GoTo ext
            Case Else
                GoTo OpenCon
        End Select
    End If
OpenCon:
    Set tmpcnnRemDataServerCursor = New ADODB.Connection
    With tmpcnnRemDataServerCursor
        'присвоим всю строку целиком от текущего конекта
        'и изменим только место расположения файла

        If Len(strPathToRemoteFile) = 0 Then
            tmpStr = PathToData()
        Else
            tmpStr = strPathToRemoteFile
        End If
        .ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.4.0" & _
                            ";User ID=Admin" & _
                            ";DATA SOURCE=" & tmpStr & _
                            ";PERSIST SECURITY INFO=FALSE" & _
                            ";Jet OLEDB:System database=C:\PROGRA~1\COMMON~1\System\SYSTEM.MDW"

        .Open
    End With
    Set cnnRemDataServerCursor = tmpcnnRemDataServerCursor

ext:
    Exit Function
mis:
    Select Case err.Number
        Case -2147217843    'Сбой проверки подлинности
            tmpLng = tmpLng +  1 
            If tmpLng <  10  Then
                Resume
            Else
                Resume Next
            End If
        Case Else
            MsgBox err.Description, vbCritical, err.Number
    End Select
End Function