Using Excel VBA to export data to MS Access table

Question

I am currently using following code to export data from worksheet to MS Access database, the code is looping through each row and insert data to MS Access Table.

Public Sub TransData()  Application.ScreenUpdating = False Application.EnableAnimations = False Application.EnableEvents = False Application.DisplayAlerts = False  ActiveWorkbook.Worksheets("Folio_Data_original").Activate  Call MakeConnection("fdMasterTemp")  For i = 1 To rcount - 1     rs.AddNew     rs.Fields("fdName") = Cells(i + 1, 1).Value     rs.Fields("fdDate") = Cells(i + 1, 2).Value     rs.Update  Next i  Call CloseConnection  Application.ScreenUpdating = True Application.EnableAnimations = True Application.EnableEvents = True Application.DisplayAlerts = True  End Sub 

---

Public Function MakeConnection(TableName As String) As Boolean '*********Routine to establish connection with database     Dim DBFullName As String    Dim cs As String     DBFullName = Application.ActiveWorkbook.Path & "\FDData.mdb"     cs = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"     Set cn = CreateObject("ADODB.Connection")     If Not (cn.State = adStateOpen) Then       cn.Open cs    End If     Set rs = CreateObject("ADODB.Recordset")     If Not (rs.State = adStateOpen) Then        rs.Open TableName, cn, adOpenKeyset, adLockOptimistic    End If  End Function 

---

Public Function CloseConnection() As Boolean '*********Routine to close connection with database  On Error Resume Next    If Not rs Is Nothing Then        rs.Close    End If      If Not cn Is Nothing Then        cn.Close    End If    CloseConnection = True    Exit Function  End Function 

Above code works fine for few hundred lines of records, but apparently it will be more data to export, Like 25000 records, is it possible to export without looping through all records and just one SQL INSERT statement to bulk insert all data to Ms.Access Table in one go?

Any help will be much appreciated.

EDIT: ISSUE RESOLVED

Just for information if anybody seeks for this, I've done a lots of search and found the following code to be work fine for me, and it is real fast due to SQL INSERT, (27648 records in just 3 seconds!!!!):

Public Sub DoTrans()    Set cn = CreateObject("ADODB.Connection")   dbPath = Application.ActiveWorkbook.Path & "\FDData.mdb"   dbWb = Application.ActiveWorkbook.FullName   dbWs = Application.ActiveSheet.Name   scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath   dsh = "[" & Application.ActiveSheet.Name & "$]"   cn.Open scn    ssql = "INSERT INTO fdFolio ([fdName], [fdOne], [fdTwo]) "   ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh    cn.Execute ssql  End Sub 

Still working to add specific fields name instead of using "Select *", tried various ways to add field names but can't make it work for now.

Answer 1

is it possible to export without looping through all records

For a range in Excel with a large number of rows you may see some performance improvement if you create an Access.Application object in Excel and then use it to import the Excel data into Access. The code below is in a VBA module in the same Excel document that contains the following test data

Option Explicit  Sub AccImport()     Dim acc As New Access.Application     acc.OpenCurrentDatabase "C:\Users\Public\Database1.accdb"     acc.DoCmd.TransferSpreadsheet _             TransferType:=acImport, _             SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _             TableName:="tblExcelImport", _             Filename:=Application.ActiveWorkbook.FullName, _             HasFieldNames:=True, _             Range:="Folio_Data_original$A1:B10"     acc.CloseCurrentDatabase     acc.Quit     Set acc = Nothing End Sub