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
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
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.