title: Using Excel VBA to export data to MS Access table
body: <p>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.</p>
  
    
  
  <pre class="lang-vb prettyprint-override"><code>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
  </code></pre>
  
  <hr>
  
  <pre class="lang-vb prettyprint-override"><code>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 &amp; "\FDData.mdb"
  
     cs = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" &amp; DBFullName &amp; ";"
  
     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
  </code></pre>
  
  <hr>
  
  <pre class="lang-vb prettyprint-override"><code>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
  </code></pre>
  
  <p>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?</p>
  
  <p>Any help will be much appreciated.</p>
  
  <p><strong>EDIT: ISSUE RESOLVED</strong></p>
  
  <p>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!!!!):</p>
  
  <pre class="lang-vb prettyprint-override"><code>Public Sub DoTrans()
  
    Set cn = CreateObject("ADODB.Connection")
    dbPath = Application.ActiveWorkbook.Path &amp; "\FDData.mdb"
    dbWb = Application.ActiveWorkbook.FullName
    dbWs = Application.ActiveSheet.Name
    scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &amp; dbPath
    dsh = "[" &amp; Application.ActiveSheet.Name &amp; "$]"
    cn.Open scn
  
    ssql = "INSERT INTO fdFolio ([fdName], [fdOne], [fdTwo]) "
    ssql = ssql &amp; "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" &amp; dbWb &amp; "]." &amp; dsh
  
    cn.Execute ssql
  
  End Sub
  </code></pre>
  
  <p>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.</p>