Tuesday, 12 May 2015

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

How to Transfer All Fields 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 All Fields of Access Database Table into an Excel Sheet using ADODB Recordset Method.
'-------------------------------------------------

Sub ADODB_Access_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 Recordset/Table:
ADO_RecSet.Open Source:=My_Table, ActiveConnection:=Conn_DB, CursorType:=adOpenStatic, 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
'To Copy only 6 rows and 3 columns of the Recordset to Excel Worksheet:
'Rng.Offset(1, 0).CopyFromRecordset Data:=ADO_RecSet, MaxRows:=6, MaxColumns:=3

'--------------------------------------------------------------
 '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
          [ BI-Reporting Analyst ]

No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts