Wednesday, 13 May 2015

ADODB Recordset Metod to Export data from Excel Worksheet to an Access Database Table

How to Export  data from Excel Worksheet to an Access Database Table using ADODB Recordset in VBA Macro
Sub ADO_Excel_2_Access()
Dim MyPath As String, DBName As String, MyDB As String, Str_SQL As String
Dim J As Long, K As Long, LastRow 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

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

FieldCount = ADO_RecSet.Fields.Count

'Finding the No.of Rows with data in Excel Sheet
LastRow = WS.Cells(Rows.Count, "A").End(xlUp).Row

'Copying Records from from Second Row of the Worksheet to Table:
For J = 2 To LastRow
ADO_RecSet.AddNew

For K = 0 To FieldCount - 1
ADO_RecSet.Fields(K).Value = WS.Cells(J, K + 1)
Next K
ADO_RecSet.Update
Next J

'Close the objects
ADO_RecSet.Close
Conn_DB.Close

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

'Destroying the Variables
Set ADO_RecSet = Nothing
Set Conn_DB = Nothing
End Sub

Please Note :
The above Macro will works fine only if the Source Data Fields and Destination Table Fields having Same Data Type and they are in Same Order.


1 comment:

  1. Nice blog!!. These VBA examples are very helpful. Thanks for sharing.

    ReplyDelete

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts