Public ADO_RaiseError As Boolean ' Флаг вызова ошибки
Private pConnect As String       ' Строка соединения с базой данных

Public Function OpenConnection(Optional ConnectString As String = "", _
                                   Optional UserName As String = "", _
                                   Optional Password As String = "", _
                                   Optional ConnectPrompt As ADODB.ConnectPromptEnum = adPromptNever, _
                                   Optional ByRef ActiveConnection As ADODB.Connection) As Boolean
Dim objCn As ADODB.Connection, bClose As Boolean

  On Error GoTo Error_Open
  If ActiveConnection Is Nothing Then
    Set objCn = New ADODB.Connection
    bClose = True
  Else
    Set objCn = ActiveConnection
    If objCn.State <> adStateClosed Then objCn.Close
    bClose = False
  End If
  ' Установка параметров соединения
  If Len(ConnectString) = 0 Then ConnectString = pConnect
  objCn.ConnectionString = ConnectString
  If Len(UserName & Password) > 0 Then
    objCn.Properties("User ID") = UserName
    objCn.Properties("Password") = Password
  End If
  objCn.Properties("Prompt") = ConnectPrompt
  ' Открытие соединения
  objCn.Open
  pConnect = objCn.ConnectionString
  ' Закрытие объекта
  If bClose Then
    objCn.Close
    Set objCn = Nothing
  End If
  OpenConnection = True
  Exit Function

Error_Open:
  If bClose Then Set objCn = Nothing
  If ADO_RaiseError Then Err.Raise Err.Number, Err.Source, Err.Description
End Function

Public Function OpenRecordset(ByRef SQL As String, _
                                  Optional CursorType As ADODB.CursorTypeEnum = adOpenForwardOnly, _
                                  Optional LockType As ADODB.LockTypeEnum = adLockReadOnly, _
                                  Optional Options As Long = adCmdText, _
                                  Optional ByRef ActiveConnection As Variant) As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim ErrCode As Long
Dim ErrDesc As String
Dim ErrSource As String

  On Error GoTo Error_Open
  ' Проверка параметра
  If IsMissing(ActiveConnection) Then ActiveConnection = pConnect
  Set rs = New ADODB.Recordset
  rs.CursorLocation = adUseClient
  rs.Open SQL, ActiveConnection, CursorType, LockType, Options
  If LockType = adLockReadOnly Then Set rs.ActiveConnection = Nothing
  Set OpenRecordset = rs
  Exit Function
  
Error_Open:
  Set rs = Nothing
  ErrCode = Err.Number
  ErrDesc = Err.Description
  ErrSource = Err.Source
  LogError "OpenRecordset: " & SQL
  If ADO_RaiseError Then
    Err.Raise ErrCode, ErrSource, ErrDesc
  End If
End Function

...

  ws.DefaultCursorDriver = dbUseDefaultCursor
  On Error GoTo 0

Exit Function '(Sub ???) 

ErrConnect:
    mb = MsgBox("Ошибка подключения к серверу !" & vbCrLf & Err.Number & ": " & Err.Description, vbOKOnly, "ADO connect")