Поиск пользователей в разделенной БД не работает

Sub netuser_SCHEMA_USER()
    Dim rst As Object, rTabl As DAO.Recordset, db As DAO.Database
    Dim s, sw, t
    Set db = CurrentDb
    Set rst = CreateObject("adodb.recordset")
    Set rst = CurrentProject.Connection.OpenSchema(-1, , SCHEMA_USER)
    Set rTabl = db.OpenRecordset("select * from ПК_в_сети")
 
    If Me.grpConnect <> 1 Then
        sw = " where not InConnect is null"
    Else
        sw = ""
    End If
 
    Do Until rst.EOF
        t = Trim(Replace(rst(0), Chr(0), ""))
        rTabl.FindFirst "СетевоеИмя='" & t & "'"
        If rTabl.NoMatch Then
            If MsgBox("В таблице соответствий не найдено сетевое имя '" & t & "'" & vbCrLf _
                & "Добавить '" & t & "' в таблицу?", vbYesNo) = vbYes Then
                DoCmd.OpenForm "frmПК_в_сети", , , , acFormAdd, acDialog, t
                Set rTabl = CurrentDb.OpenRecordset("select * from ПК_в_сети")
                rTabl.FindFirst "СетевоеИмя='" & t & "'"
                If Not rTabl.NoMatch Then
'                        s = s & ";" & oComp.name & ";" & rTabl(1)
                    rTabl.Edit: rTabl!InConnect = "В сети": rTabl.Update
                End If
                Me.lstUsers.Requery
            End If
        Else
'            s = s & ";" & t & ";" & rTabl(1)
            rTabl.Edit: rTabl!InConnect = "В сети": rTabl.Update
        End If
        rst.MoveNext
    Loop
    Me.lstUsers.RowSource = "select * from ПК_в_сети" & sw 'Mid(s, 2)
End Sub

Sub netuser_SCHEMA_USER()
    Dim rst As Object, rTabl As DAO.Recordset, db As DAO.Database
    Dim cnn As ADODB.Connection
    Dim s, sw, t
    cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\O:\ОДС\Закрытая\Заявочник\Заявочник 2018_be.accdb;"
    cnn.Open
    Set rst = cnn.OpenSchema(adSchemaProviderSpecific, , SCHEMA_USER)
    Set rTabl = db.OpenRecordset("select * from ПК_в_сети")

Sub netuser_SCHEMA_USER()
Dim rst As Object, rstT As Object, cnn As Object
Dim strSQL As String, strName As String
 
Const adOpenKeyset = 1&, adLockOptimistic = 3&, adCmdText = 1&
 
On Error GoTo HandleErrors
 
Set cnn = CreateObject("adodb.Connection")
cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=O:\ОДС\Закрытая\Заявочник\Заявочник 2018_be.accdb;"
cnn.Open
    If cnn.State = 1 Then
        Set rst = cnn.OpenSchema(-1, , SCHEMA_USER)
        Set rstT = CreateObject("adodb.recordset")
        strSQL = "select * from ПК_в_сети"
        rstT.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdText
            Do Until rst.EOF
                strName = Trim(Replace(rst(0), vbNullChar, vbNullString))
1:
                rstT.Find "[СетевоеИмя]='" & strName & "'", Start:=1
                    If rstT.EOF Then
                        If MsgBox("В таблице соответствий не найдено сетевое имя '" & strName & "'" & vbCrLf _
                            & "Добавить '" & strName & "' в таблицу?", vbYesNo) = vbYes Then
                            
                            DoCmd.OpenForm "frmПК_в_сети", , , , acFormAdd, acDialog, strName
                            rstT.Requery
                            GoTo 1
                        End If
                    Else
                        rstT!InConnect = "В сети"
                        rstT.Update
                    End If
                rst.MoveNext
            Loop
            If Me.grpConnect <> 1 Then strSQL = strSQL & " where not InConnect is null"
        Me.lstUsers.RowSource = strSQL
    End If
ExitHere:
        If Not cnn Is Nothing Then If cnn.State = 1 Then cnn.Close
    Set cnn = Nothing
        If Not rst Is Nothing Then If rst.State = 1 Then rst.Close
    Set rst = Nothing
        If Not rstT Is Nothing Then If rstT.State = 1 Then rstT.Close
    Set rstT = Nothing
    Exit Sub
HandleErrors:
    Debug.Print Err.Number & vbNewLine & Err.Description
    Resume ExitHere
End Sub