Access VBA ADODB CopyFromRecordset Method to Copy Selected Fields Data from Access Table to Excel

Access VBA ADODB CopyFromRecordset Method to Copy Selected Fields or SQLQuery Results Data from Access Table to Excel

How to Transfer Selected Fields/SQL Query Result data from an Access ADO Recordset to Excel with VBA Macro

'Using ADO Method to Import data from an Access Database Table to an Excel worksheet, we need to use ADO in your VBA project, you must add a reference to the ADO Object Library in Excel.
'By clicking Tools-References in VBA, and then choose an appropriate version of Microsoft ActiveX Data Objects x.x Library from the list, as shown below :

The following Macro has written in Excel VBA Module to Import/Copy Data from a Selected Fields/SQL Query results from Access Database Table into an Excel Sheet using ADODB Recordset Method.

'-------------------------------------------------

Sub ADODB_Access_Selected_2_Excel()
Dim MyPath As String, DBName As String, MyDB As String, Str_SQL As String
Dim J As Long, K As Long, FieldCount As Long

Dim Rng As Range
Dim WS As Worksheet

'Initiating an ADO object using Dim with the New keyword:
Dim ADO_RecSet As New ADODB.Recordset
Dim Conn_DB As New ADODB.Connection

DBName = "Sales_Database.accdb"         ' Your Database Name
MyPath = ThisWorkbook.Path                      ' Path of Your Database
MyDB = MyPath & "\" & DBName                ' Full Path of Your Database
My_Table = "Sales_Table"                           ' Your Table Name

'Connect to the data source:
'For pre - MS Access 2007 Versions, like .mdb files (Ex: MS Access 97 up to MS Access 2003) use the Jet provider: "Microsoft.Jet.OLEDB.4.0".
'For Access 2007 (.accdb database) use the ACE Provider: "Microsoft.ACE.OLEDB.12.0".
'The ACE Provider can be used for both the Access .mdb & .accdb files.

Conn_DB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; Data Source=" & MyDB

Set WS = ActiveWorkbook.Sheets("Data")
WS.Activate
WS.Range("A1").Select

'Set the ADO Recordset object:
Set ADO_RecSet = New ADODB.Recordset

'Opening Selected Fields from Recordset based on SQL Query Result:
Str_SQL = "SELECT Sales_Period, Prod_Id, NetSales From SALES_TABLE Where NetSales >500"

ADO_RecSet.Open Source:=Str_SQL , ActiveConnection:=Conn_DB, CursorType:=adOpenDynamic, LockType:=adLockOptimistic

Set Rng = WS.Range("A1")

FieldCount = ADO_RecSet.Fields.Count

'----------------------------------------------------------------------------------------------

'--------------------------------------------------------------

 'Method I : Direct Copy & Pasting all the Fields data from RecordSet into Excel

'--------------------------------------------------------------

For J = 0 To FieldCount - 1

'Copy Column Names to First Row of the Worksheet:

Rng.Offset(0,J).Value = ADO_RecSet.Fields(J).Name

Next J

'Copying Records from Recordset and Pasting from Second Row of the Worksheet:

Rng.Offset(1, 0).CopyFromRecordset ADO_RecSet

'--------------------------------------------------------------

 'Method II : Looping through RecordSet and Then Copy Pasting data by Field into Excel

'--------------------------------------------------------------

For J = 0 To FieldCount - 1

'Copy Column Names to First Row of the Worksheet:

Rng.Offset(0, J).Value = ADO_RecSet.Fields(J).Name

ADO_RecSet.MoveFirst

'Copying Records from Recordset and Pasting from Second Row of the Worksheet:

K = 1

Do While Not ADO_RecSet.EOF

Rng.Offset(K, J).Value = ADO_RecSet.Fields(J).Value

ADO_RecSet.MoveNext

K = K + 1

Loop

Next J

'----------------------------------------------------------------------------------------------

'Selecting a All Columns in Data rangein Excel to Auto Filt:

Range(WS.Columns(1), WS.Columns(FieldCount)).AutoFit

'Selecting a All Columns in Data range in Excel to Delete:

'Range(WS.Columns(1), WS.Columns(FieldCount)).Delete

ADO_RecSet.Close

'Close the objects

Conn_DB.Close

MsgBox "All the Records Copied from Target Access Table To Excel Sheet", vbOKCancel, "Job Done"

'Destroying the Variables

Set ADO_RecSet = Nothing

Set Conn_DB = Nothing

End Sub

--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------