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.
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.
--------------------------------------------------------------------------------------------------------
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.