Thursday, 4 September 2014

How to Import or Copy All Data from a MS Access Database Table in to Excel Sheet

Excel VBA Macro to Import or Copy All Data from a MS Access Database Table into Excel Sheet
Sub Import_AllData_From_AccDB_Table_To_Excel()
'Using ADO to Import data from an Access Database Table to an Excel worksheet (your host application).

'To use ADO in your VBA project, you must add a reference to the ADO Object Library in Excel(your host application) by clicking Tools-References in VBE,and then choose an appropriate version of Microsoft ActiveX Data Objects x.x Library from the list.

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"

'Open Recordset/Table:

ADO_RecSet.Open Source:=DB_Table, ActiveConnection:=Conn_DB, CursorType:=adOpenStatic, 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

'Close the objects

'Destroy the Variables
Set ADO_RecSet = Nothing
Set Conn_DB = Nothing
MsgBox "Table has been Copied SuccessFully", vbOKOnly, "Job Done"

End Sub

No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts