Private Sub Кнопка23_Click()    
    Dim d As Dictionary
    Dim s As String
    Dim rs As ADODB.Recordset
    Dim sSql As String
    sSql = "SELECT [Наименование проекта] FROM Проекты IN '' [MS Access;DATABASE=" & sPath & ";pwd=" & sPass & "];"
    Debug.Print sSql
    Set rs = CurrentProject.Connection.Execute(sSql)
    rs.MoveFirst
    Do Until rs.EOF
        s = rs.Fields("Наименование проекта")
        Set d = GetKust2(s)
        For Each a In d
            If Len(a) > 4 Or a = "Нет" Then
                фЧтоКорректировать.AddItem a & " - " & s, 0
            End If
        Next a
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
End Sub

SELECT [Наименование проекта] FROM Проекты IN '' [MS Access;DATABASE=C:\Art\МАКРОСЫ\MS_Access\ПроблеммныеВопросыИльнура\serv_BD.accdb;pwd=rf];

Private Sub Кнопка23_Click()    
    Dim d As Dictionary
    Dim s As String
    Dim rs As ADODB.Recordset
    Dim sSql As String
    sSql = "SELECT [Наименование проекта] FROM Проекты IN '' [MS Access;DATABASE=" & sPath & ";pwd=" & sPass & "] WHERE [Наименование проекта] LIKE " & sMask1 & ";"
    Debug.Print sSql
    Set rs = CurrentProject.Connection.Execute(sSql)
    rs.MoveFirst
    Do Until rs.EOF
        s = rs.Fields("Наименование проекта")
        Set d = GetKust2(s)
        For Each a In d
            If Len(a) > 4 Or a = "Нет" Then
                фЧтоКорректировать.AddItem a & " - " & s, 0
            End If
        Next a
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
End Sub

rs.MoveFirst

SELECT [Наименование проекта] FROM Проекты IN '' [MS Access;DATABASE=C:\Art\МАКРОСЫ\MS_Access\ПроблеммныеВопросыИльнура\serv_BD.accdb;pwd=rf] WHERE Проекты.[Наименование проекта] LIKE '*бустройств*уст*кважи*#*';