Пример перевода DAO в ADO

   Dim rs As DAO.Recordset
   Set rs = CurrentDb.OpenRecordset("AUTH", dbOpenDynaset)
   rs.MoveFirst
   Do Until rs.EOF
     If rs!login = Me.field_login Then
       If rs!passwd = Me.passwd Then
       login_name = Me.field_login
       DoCmd.OpenForm "DISTRIB"
       rs.MoveLast
       rs.MoveNext
       DoCmd.Close acForm, "Auth_start", acSaveYes
       Else
       MsgBox "Password do not match!"
       Me.passwd = ""
       rs.MoveLast
       rs.MoveNext
       End If
     Else
     rs.MoveNext
    End If
   Loop

   Dim rs As Object 'As ADODB.Recordset если подключена библиотека msado
   Set rs = Currentproject.connection.execute("AUTH")

Public Function GetData(sExpression$, sSourse$, Optional vCriteria As Variant = Null, _
        Optional vDefault As Variant = Null, _
        Optional vOptions As Variant = Null) As Variant
'--------------------------------------------------------------------
'es 14.12.2016  : msa.polarcom.ru
'Возвращает:
'   Значение (выражения) указанное в sExpression из таблицы или запроса указанного в sSourse
'   по условиям отбора указанным в vCriteria (Опционально)
'При ошибке или отсутствии данных в источнике - Вернет значение  указанное в vDefault (Null)
'--------------------------------------------------------------------
'Аргументы:
'    sExpression   - Название поля или Выражение с его участием (для SELECT ...)
'    vCriteria     - Критерии отбора записей для WHERE ...
'    vDefault      - Значение возврвщаемое если искомое не найдено (или = Null)
'    vOptions      - Поле и Порядок сортировки (Типа: "ORDER BY ..." или "DESC" и т.п.)
'--------------------------------------------------------------------
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sSql$
'--------------------------------------------------------------------
On Error GoTo GetData_Err
    Set cnt = CurrentProject.Connection ' Локально
    cnt.CursorLocation = 2 'adUseServer (2) - adUseClient (3)
    Set rst = CreateObject("ADODB.Recordset")
    rst.CursorLocation = 2 'adUseServer (2) - adUseClient (3)
    
    sSql = "SELECT " & sExpression & " FROM " & sSourse & (" WHERE " + vCriteria) & (" " + vOptions)
    rst.Open sSql, cnt, adOpenStatic, adLockReadOnly
    
    GetData = rst.Fields(0) 'Берём заказанное значение
    If IsNull(GetData) = True Then GetData = vDefault
 
GetData_Bye:
    On Error Resume Next
    rst.Close: Set rst = Nothing
    cnt.Close: Set cnt = Nothing
    Exit Function
 
GetData_Err:
    GetData = vDefault: Err.Clear: Resume GetData_Bye
End Function

    conn.Close
    Set conn = Nothing

 Dim passwd, strSQL As String
 If IsNull(field_login.Value) = True Then
  MsgBox "Enter LOGIN please!"
 ElseIf IsNull(field_passwd.Value) = True Then
  MsgBox "Enter PASSWORD please!"
  Else
    Set conn = Nothing
    Set conn = New ADODB.Connection
    conn = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=D:\!!!_work\!_Prof-Service\ACCESS-DB\!_PofServ_access\ProfServ_base_1.0.accdb;Uid=Admin;Pwd=;"
    conn.Open
    Set passwd = ("SELECT 'passwd' FROM 'AUTH' WHERE 'login' = " & Me.field_login)
    MsgBox passwd
    conn.Close
    Set conn = Nothing
End If

Set conn = New ADODB.Connection
strConn = "DRIVER=SQL Server;SERVER=DCS\DCS;Trusted_Connection=Yes;APP=Microsoft Office 2010;DATABASE=ddc"
conn.Open strConn

MsgBox "Соединение установлено"

strSql = "SELECT passwd FROM AUTH WHERE login = '" & Me.field_login & "'"
passwd.Open sstrSql, conn

rs.Fields("id").Value