Dim Conn
Dim Ary()

Sub test_conn()
Set Conn = New ADODB.Connection

If UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" Then
Else
UserForm1.Show
End If

Conn.ConnectionString = "Provider=SQLOLEDB.1;Data Source=177.17.3.176;Initial Catalog=MainDWH;User ID=" & UserForm1.TextBox1.Text & ";Password=" & UserForm1.TextBox2.Text
Dim rs As ADODB.Recordset
Conn.Open

Set rs = Conn.Execute("SELECT TOP 10 * FROM MainDWH.dbo.AFS_request_in")
Ary = rs.GetRows()

MsgBox Ary(8, 1)
End Sub

Private Sub CommandButton1_Click()

On Error GoTo какашка

Dim str As String, sstr As String, tn As String, t As Integer, tek As Field, str2(50)  As String 'str2 список полей, максимум 50. tn имя таблицы, str предмет поиска
t = 1

'str2 = ActiveCell.Value

Texcel = ActiveWorkbook.Sheets("set").Cells(1, 3).Value
str = Workbooks(Texcel).Sheets("set").Cells(1, 1).Value

Dolby:
str2(t) = Workbooks(Texcel).Sheets(1).Cells(5, t).Value

If Workbooks(Texcel).Sheets(1).Cells(5, t + 1).Value <> "" Then t = t + 1: GoTo Dolby
Set ЭтаКнига.Dbase = DAO.OpenDatabase(str)

tn = Workbooks(Texcel).Sheets(1).Cells(3, 5 + Workbooks(Texcel).Sheets(1).Cells(2, 6).Value).Value
str = Workbooks(Texcel).Sheets(1).Cells(2, 1).Value
Workbooks(Texcel).Sheets(1).Range("A6:Z1000001").Clear

' ЭтаКнига.SQLstr = "SELECT * FROM " & tn & " WHERE " & str2 & " LIKE '*" & str & "*'" ' работает если перед поиском выделить имя поля
ЭтаКнига.SQLstr = "SELECT * FROM " & tn & " WHERE "
t = 1
sstr = str2(t) & " LIKE '*" & str & "*'"
dolby2:

If str2(t + 1) <> "" Then t = t + 1: sstr = sstr & " OR " & str2(t) & " LIKE '*" & str & "*'": GoTo dolby2
ЭтаКнига.SQLstr = ЭтаКнига.SQLstr & sstr

Set ЭтаКнига.RS = ЭтаКнига.Dbase.OpenRecordset(ЭтаКнига.SQLstr)
Workbooks(Texcel).Sheets(1).Cells(6, 1).CopyFromRecordset ЭтаКнига.RS

' закрываем таблицу очищаем память
ЭтаКнига.Dbase.Close
Set ЭтаКнига.Dbase = Nothing
Set ЭтаКнига.RS = Nothing
Exit Sub
какашка:
MsgBox Err.Number & " - " & Err.Description, vbCritical, "Чтото пошло не так..."
Set Dbase = Nothing
Set RS = Nothing
End Sub

ЭтаКнига.SQLstr

Set ЭтаКнига.RS = ЭтаКнига.Dbase.OpenRecordset(ЭтаКнига.SQLstr)

Workbooks(Texcel).Sheets(1).Cells(6, 1).CopyFromRecordset ЭтаКнига.RS

dolby2:

If str2(t + 1) <> "" Then t = t + 1: sstr = sstr & " OR " & str2(t) & " LIKE '*" & str & "*'": GoTo dolby2
ЭтаКнига.SQLstr = ЭтаКнига.SQLstr & sstr

Sub compare1()
    Dim a, b, c, iLastrow As Long, i As Long, ii As Long

    '1. данные в два массива
    With Sheets("получено")    'используется кодовое имя
        iLastrow = .Cells(Rows.Count, 4).End(xlUp).Row
        a = Range(.[d2], .Range("D" & iLastrow)).Value
    End With

    With Sheets("отправлено")     'используется кодовое имя
        iLastrow = .Cells(Rows.Count, 10).End(xlUp).Row
        b = .[a2].Resize(iLastrow, 20).Value
    End With

    '2.пустой массив для результата
    ReDim c(1 To UBound(a), 1 To 2)

    With CreateObject("Scripting.Dictionary")
    
        '3.в словарь уникальные и номер строки из массива
        For i = 1 To UBound(b)
            .Item(b(i, 10)) = i
        Next

        '4.по словарю из массива b в массив c
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
                c(i, 1) = b(.Item(a(i, 1)), 1)
                c(i, 2) = b(.Item(a(i, 1)), 2)
            End If
        Next
    End With

    '5. выгрузка всего массива
    With Sheets("получено")    'используется кодовое имя
        .[a2].Resize(UBound(c), 2) = c
        .Activate
    End With

End Sub

.Item(b(i, 10)) = i

.Item(b(i, 10) & b(i, 11)) = i

.exists(a(i, 1))

.exists(a(i, 1) & a(i, 2))

Public Sub test()
    Dim pConn As New ADODB.Connection
    Dim pRSet As New ADODB.Recordset
    Dim selData As Variant, i As Long
    Dim sSQL As String, outSheet As Worksheet
    
    pConn.Open "Provider=SQLOLEDB.1;Data Source=177.17.3.176;Initial Catalog=MainDWH;User ID=Login;Password=Password;"
    pConn.Execute "Create Table #selTable (FirstName nvarchar(32), LastName nvarchar(32))", Options:=adExecuteNoRecords
    
    selData = Range("A2:B100")
    pRSet.Open "Select * From #selTable;", pConn, adOpenStatic, adLockOptimistic
    For i = 1 To UBound(selData)
        pRSet.AddNew
        pRSet(0).Value = selData(i, 1)
        pRSet(1).Value = selData(i, 2)
    Next
    pRSet.Update: pRSet.Close
    sSQL = "Select TSel.FirstName, TSel.LastName, TMain.Field1, TMain.Field2"
    sSQL = sSQL & " From #selTable TSel Left Join MainDWH.dbo.AFS_request_in TMain"
    sSQL = sSQL & " On (TSel.FirstName = TMain.FirstName And TSel.LastName = TMain.LastName)"
    pRSet.Open sSQL, pConn
    Set outSheet = ActiveWorkbook.Worksheets.Add
    For i = 0 To pRSet.Fields.Count - 1
        outSheet.Cells(1, i + 1).Value = pRSet(i).Name
    Next
    outSheet.Range("A2").CopyFromRecordset pRSet
    pRSet.Close: pConn.Close
    Set pRSet = Nothing: Set pConn = Nothing
End Sub

Dim Conn
Dim Ary()
Dim SQL As String

Sub test_conn()
Set Conn = New ADODB.Connection

'If UserForm1.TextBox1.Text <> "" And UserForm1.TextBox2.Text <> "" Then
'Else
'UserForm1.Show
'End If

Conn.ConnectionString = "Provider=SQLOLEDB.1;Data Source=198.19.5.177;Initial Catalog=MainDWH;User ID=***;Password=***"
Dim rs As ADODB.Recordset
Conn.Open

Conn.Execute = "CREATE TABLE #AFS" _
             & "(BPID int," _
             & "lastName nvarchar(20)," _
             & "firstName nvarchar(20)," _
             & "secondName nvarchar(20)," _
             & " birthDate datetime," _
             & "sex nvarchar(1)," _
             & "seriesNumber nvarchar(12)," _
             & " docdate datetime," _
             & "AfsMessage nvarchar(1000));" _
             & "INSERT INTO #AFS(BPID,lastName, firstName,secondName,birthDate,sex,seriesNumber,docdate)" _
             & "SELECT ANKETA_ID,ANKETA_FAM,ANKETA_IM,ANKETA_OT,ANKETA_BIRTH_DATE,ANKETA_SEX,ANKETA_SERIESPASSPORT,ANKETA_DATEPASSPORT" _
             & "FROM Port.Ankets"

Set rs = Conn.Execute("SELECT TOP 10 * FROM #AFS")
Ary = rs.GetRows()
MsgBox Ary(0, 0)

End Sub

Sub test_conn()
Dim Conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Set Conn = New ADODB.Connection

Conn.ConnectionString = "driver={SQL Server};server=177.17.3.176;uid=MyLog;pwd=MyPass;database=MainDWH"
Conn.Open

Set rs = Conn.Execute(ActiveWorkbook.Sheets("Лист2").Range("A1").Value)

End Sub

CREATE TABLE ##AFS
(
BPID int,
lastName nvarchar(20),
firstName nvarchar(20),
secondName nvarchar(20),
birthDate datetime,
sex nvarchar(1),
seriesNumber nvarchar(12),
docdate datetime,
AfsMessage nvarchar(1000)
);
INSERT INTO ##AFS(BPID,lastName, firstName,secondName,birthDate,sex,seriesNumber,docdate)
SELECT TOP 100 ANKETA_ID,ANKETA_FAM,ANKETA_IM,ANKETA_OT,ANKETA_BIRTH_DATE,ANKETA_SEX,ANKETA_SERIESPASSPORT,ANKETA_DATEPASSPORT
FROM Port.Ankets

Set rs = Conn.Execute("CREATE TABLE #AFS" _
            & "(BPID int," _
            & "lastName nvarchar(20)," _
            & "firstName nvarchar(20)," _
            & "secondName nvarchar(20)," _
            & " birthDate datetime," _
            & "sex nvarchar(1)," _
            & "seriesNumber nvarchar(12)," _
            & " docdate datetime," _
            & "AfsMessage nvarchar(1000));" _
            & "INSERT INTO #AFS(BPID,lastName, firstName,secondName,birthDate,sex,seriesNumber,docdate)" _
            & "SELECT ANKETA_ID,ANKETA_FAM,ANKETA_IM,ANKETA_OT,ANKETA_BIRTH_DATE,ANKETA_SEX,ANKETA_SERIESPASSPORT,ANKETA_DATEPASSPORT" _
            & "FROM Port.Ankets")

Set rs = Conn.Execute("CREATE TABLE #AFS" &  _
            "(BPID int")