Sub ab123()
    With ActiveWorkbook.Connections("storage_f11").OLEDBConnection
        .BackgroundQuery = True
        .CommandText = Array("select * from buh2016_1 where buh2016_1.inn = '7708004767'")
        .CommandType = xlCmdSql
        .Connection = Array("OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\s.v.kutenko\Desktop\workhard\entity_db\storage_f1.accdb;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False")
        .RefreshOnFileOpen = False
        .SavePassword = False
        .SourceConnectionFile = ""
        .SourceDataFile = "C:\Users\s.v.kutenko\Desktop\workhard\entity_db\storage_f1.accdb"
        .ServerCredentialsMethod = xlCredentialsMethodIntegrated
        .AlwaysUseConnectionFile = False
        .ServerFillColor = False
        .ServerFontStyle = False
        .ServerNumberFormat = False
        .ServerTextColor = False
    End With
End Sub

.CommandText = Array("select * from buh2016_1 where buh2016_1.inn = '" & ThisWorkbook.Worksheets("Имя листа").Range("$A$1").Value & "'")

Sub importAccessdata()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim strFilePath As String

strFilePath = "C:\Users\***\storage_f1.accdb"

Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source = " & strFilePath & ";"
sQRY = "select * from buh2016_1 where buh2016_1.inn = '7708004767'"


rs.CursorLocation = adUseClient
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False

ActiveSheet.Range("A1").CopyFromRecordset rs

rs.Close
    Set rs = Nothing
cnn.Close
    Set cnn = Nothing

Exit Sub
End Sub