Excel VBA Macro to Import or Copy All Data with SQL Query from Specific Fields of a MS Access Table into Excel Sheet

Excel VBA Macro to Import or Copy All Data with SQL Query from Specific Fields of a MS Access Table into Excel Sheet
Sub Import_SpecificData_From_Access_Table_Fields_To_Excel()
Dim Str_MyPath As String, Str_DBName As String, Str_DB As String, Str_SQL As String
Dim K As Long, N As Long, Fields_Count As Long
Dim Rng As Range

Dim ADO_RecSet As New ADODB.Recordset
Dim Conn_DB As New ADODB.Connection

Str_DBName = "Sales_DB.accdb"
Str_MyPath = "C:\Users\Tamatam\Desktop\Temp"
Str_DB = Str_MyPath & "\" & Str_DBName

'Connect to a data source:
'For Pre - MS Access 2007, .mdb files (viz. 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=" & Str_DB

Dim WS As Worksheet
Set WS = ActiveWorkbook.ActiveSheet

Set ADO_RecSet = New ADODB.Recordset
DB_Table = "Products"

'COPY All RECORDS FROM Selected FIELDS USING CopyFromRecordset:
'Open Recordset/Table:
Str_SQL= "SELECT Product_ID, Prod_Name,Product_Group,Sales_Date FROM Products WHERE Product_Group='Bikes'"

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

Set Rng = WS.Range("A1")
Fields_Count = ADO_RecSet.Fields.Count

'Copy Column Names of Table into First Row of the Worksheet:
For K = 0 To Fields_Count - 1
Rng.Offset(0, K).Value = ADO_RecSet.Fields(K).Name
Next K

'Copy All Records values to the Worksheet starting from Second Row :
Rng.Offset(1, 0).CopyFromRecordset ADO_RecSet

'To Copy only 8 Rows and 4 Columns of the Recordset to Excel Worksheet:
'Rng.Offset(1, 0).CopyFromRecordset Data:=ADO_RecSet, MaxRoWS:=8, MaxColumns:=4

'Select a Column Range:
Range(WS.Columns(1), WS.Columns(Fields_Count)).AutoFit
ADO_RecSet.Close

'Close the objects
Conn_DB.Close
'Destroy the Variables
Set ADO_RecSet = Nothing
Set Conn_DB = Nothing

MsgBox "Table has been Copied SuccessFully", vbOKOnly, "Job Done"
End Sub

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