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.

Lubber

@Fionnuala the code is using ADO..the CreateObject("ADODB.Connection") will create ADO object.. – Lubber

For an .accdb file, use scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath – Digester

The edit should be posted as answer. I think it is the best way to transfer data from Excel or even from Text Files using VBA. Just need to update connection strings for example Excel 8.0 to Excel 12.0 Xlm / Excel 12.0 for newer versions of Excel. And the ACE provider equivalent for JET of course. – Mim

@Mim thanks but i think there is some restrictions where poster cannot answer his own question.. – Lubber

I used the same query with ACE and I can select specific rows I need to load. But yeah, I'm running on 64 bit device. I cannot replicate the issue you've having with JET. But I still think it should be posted as answer. You ended up using it anyways. :) – Mim

I like your issue-resolved method. Unfortunately I can't get it to work and I've narrowed it down to the FROM [...] portion. I get an error that says the database is read only. Thoughts? (The Access db isn't read only. It works when I modify the SQL to insert hard coded values.) – Nablus

@TravisBemrose check the version of Ms Office installed in your pc/laptop and change [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "] accordingly – Lubber

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

Therewith

I've use the code and got the error: "Could not find installable ISAM" – Lubber

Got it working...just change the import type to 5........A very big thanks....... :) – Lubber

Why not straight DAO and SQL rather than an Access instance? – Barranquilla

what references do you need to run this? – Memory

Answer 2

@Ahmed

Below is code that specifies fields from a named range for insertion into MS Access. The nice thing about this code is that you can name your fields in Excel whatever the hell you want (If you use * then the fields have to match exactly between Excel and Access) as you can see I have named an Excel column "Haha" even though the Access column is called "dte".

Sub test()
    dbWb = Application.ActiveWorkbook.FullName
    dsh = "[" & Application.ActiveSheet.Name & "$]" & "Data2"  'Data2 is a named range


sdbpath = "C:\Users\myname\Desktop\Database2.mdb"
sCommand = "INSERT INTO [main] ([dte], [test1], [values], [values2]) SELECT [haha],[test1],[values],[values2] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh

Dim dbCon As New ADODB.Connection
Dim dbCommand As New ADODB.Command

dbCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sdbpath & "; Jet OLEDB:Database Password=;"
dbCommand.ActiveConnection = dbCon

dbCommand.CommandText = sCommand
dbCommand.Execute

dbCon.Close


End Sub

Virtuoso