Получить данные из Access в excel

'Option Explicit
 
Sub getDataFromAccess()
' Click on Tools, References and select
' the Microsoft ActiveX Data Objects 2.0 Library
 
Dim DBFullName As String
Dim Connect As String, Source As String
'Dim Connection As ADODB.Connection
'Dim Recordset As ADODB.Recordset
Dim Col As Integer
 
 
Set Connection = CreateObject("ADODB.Connection")
Set Recordset = CreateObject("ADODB.Recordset")
 
Cells.Clear
 
' Database path info
 
' Your path will be different
DBFullName = "C:\Users\e-dro_000\Desktop\test .accdb"
' Open the connection
'Set Connection = New ADODB.Connection
Set Connection = CreateObject("ADODB.Connection")
 
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect
 
' Create RecordSet
'Set Recordset = New ADODB.Recordset
Set Recordset = CreateObject("ADODB.Recordset")
 
With Recordset
' Filter Data
Source = "SELECT * FROM tCompany"
'Source = "SELECT * FROM tCompany WHERE [Код] = 1"
'Source = "SELECT * FROM Customers WHERE [Job Title] = 'Owner’ "
 
.Open Source:=Source, ActiveConnection:=Connection
 
' MsgBox "The Query:" & vbNewLine & vbNewLine & Source
 
' Write field names
For Col = 0 To Recordset.Fields.Count - 1
Range("A1").Offset(0, Col).Value = Recordset.Fields(Col).Name
Next
 
' Write recordset
Range("A1").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
End Sub