Using Excel Vba to Export Data to Ms Access Table

Using Excel VBA to export data to MS Access table

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

Export data to Access from Excel VBA

When inserting using queries, you need to pass values using parameters. I highly recommend using recordsets over insert queries.

A normal insert query can only insert one row at a time. You will need to adjust the code to insert one row at a time. You can either use a recordset, or execute a query for each row.

Foodrng = Workbooks(xlFile).Sheets("ToBeExported").Range("D6") 'Adjust ranges to select single cells
Drinksrng = Workbooks(xlFile).Sheets("ToBeExported").Range("E6")
Colorrng= Workbooks(xlFile).Sheets("ToBeExported").Range("B12:B21")

Set cn = CreateObject("ADODB.Connection")
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source= C:\Users\User1\MyDBase.accdb"
cn.Open strConnection

strSql = "INSERT INTO [Data] ([Food], [Drinks], [Color]) VALUES (?, ?, ?)"
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
    Set .ActiveConnection = cn
    .CommandText = strSql
    .Parameters.Append .CreateParameter(, adVarWChar, adParamInput, , foodRng) 'adVarWChar for text 
    .Parameters.Append .CreateParameter(, adInteger, adParamInput, , Drinksrng) 'adInteger for whole numbers (long or integer)
    .Parameters.Append .CreateParameter(, adInteger, adParamInput, , Colorrng)
    .Execute
End With
cn.Close

How to export data from Excel to Access via Excel Macro when multiple instances of Excel are open

I tested approach that opens Access db and runs TransferSreadsheet. Don't need to set a workbook object (your code sets but then doesn't even utilize). It ran without error every time. I tried setting the Access object Visible but the database appears and immediately closes anyway, although the data import does happen. Set reference libarary: Microsoft Access x.x Object Library.

Sub test()
Dim ac As Access.Application, strRange As String
Set ac = New Access.Application
strRange = "Sheet1!A1:E3"
ac.OpenCurrentDatabase "C:\Users\June\LL\Umpires.accdb"
ac.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Rates", ThisWorkbook.FullName, True, strRange
End Sub

Example Excel VBA code that exports all rows of worksheet to existing table in Access without opening Access file. Setting an ADODB connection makes the Execute method available. This approach runs faster. Set reference library: Microsoft ActiveX Data Objects x.x Library.

Sub test()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0"
cn.Execute "INSERT INTO Rates(RateLevel, Rate, Pos, EffDate) IN 'C:\Users\June\LL\Umpires.accdb' " & _
           "SELECT RateLevel,Rate,Pos,EffDate FROM [Sheet1$];"
cn.Close
Set cn = Nothing
End Sub

Exporting data from excel to access-VBA

From Excel to Access . . .

Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\Documents\"

' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "tablename"

strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
      strPathFile = strPath & strFile
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            strTable, strPathFile, blnHasFieldNames

' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
'       Kill strPathFile

      strFile = Dir()
Loop

Export Excel sheet into Access Table & overwrite (or rename and create new)

In the end I have gone for a loop method adding the results. See the code below:

Dim db As DAO.Database, rs As DAO.Recordset, ws As Worksheet, i As Long, j As Long, arr, _
lrow As Long, lcol As Long, TblName As String, Info As Worksheet, StrPath As String, tbldf As DAO.TableDef

Set Info = Sheets("Info")
TblName = Info.Range("R6").Value
StrPath = Info.Range("R7").Value

Set ws = Sheets(TblName)
lrow = ws.Range("A" & Rows.Count).End(xlUp).Row
lcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
arr = ws.Range(ws.Cells(2, 1), ws.Cells(lrow, lcol)).Value
Set db = OpenDatabase(StrPath)

Set rs = db.OpenRecordset(TblName)

For i = 0 To rs.Fields.Count - 1
    If rs.Fields(i).Name <> ws.Cells(1, i + 1).Value Then
        MsgBox "There is a mis-match of the headers between the database and Excel sheet. You will need to ensure these are matched up " & _
        "before you continue", vbExclamation, "Mis-matched data"
        Exit Sub
    End If
Next i

On Error Resume Next
Set tbldf = db.TableDefs(TblName & "_ALL")
On Error GoTo 0
If tbldf Is Nothing Then
    db.Execute ("SELECT * INTO [" & TblName & "_ALL] FROM " & TblName)
End If

db.Execute "DELETE * FROM " & TblName

For i = 1 To UBound(arr, 1)
    rs.AddNew
    For j = 1 To UBound(arr, 2)
        rs.Fields(j - 1) = arr(i, j)
    Next j
    rs.Update
Next i

rs.Close
Set rs = Nothing
db.Close

Testing on a 68 column x 105K row table of data, it ran in just under 30 seconds on my machine which is plenty acceptable for me. This is not the full code I will use but is the code I needed from my question.

I managed this through a lot of help from Chris Maurer's answers/comments as well as searching. Thank you Chris for your assistance.

MS Access table export as excel file to user defined folder

As @Shanayl points out, you can prompt the user to select a folder on their local machines and then pass the result into DoCmd.TransferSpreadsheet since it accepts a string value. Do not simply concatenat fd into file path.

Below modifies @eabraham's answer to run a folder picker dialog not file picker for user in a VBA function and not a VBA sub to be called later for Excel file.

Function (place behind form/report in same area as button click event)

Private Function GetExcelFolder() As String       
   Dim fldr As FileDialog
   Dim txtFileName As String

   ' FOLDER PICKER
   Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

   With fldr
      .AllowMultiSelect = False

      ' Set the title of the dialog box.
      .Title = "Please select folder for Excel output."

      ' Show the dialog box. If the .Show method returns True, the
      ' user picked at least one file. If the .Show method returns
      ' False, the user clicked Cancel.
      If .Show = True Then
        txtFileName = .SelectedItems(1)
      Else
        Msgbox "No File Picked!", vbExclamation
        txtFileName = ""
      End If
   End With

   ' RETURN FOLDER NAME
   GetExcelFolder = txtFileName       
End Function

Button Click Event

Private Sub Command3_Click()
    Dim user_excel_fldr As String

    ' CALL FUNCTION
    user_excel_fldr = GetExcelFolder()    
    If user_excel_fldr = "" Then Exit Sub

    ' SPECIFY ONE TABLE
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "myTableName", _
       user_excel_fldr & "\" & "ExcelOutput.xlsx", True
End Sub

And for every table in your database, loop through TableDefs, using range argument of MS Access's DoCmd.TransferSpreadsheet method to output each to specific worksheet tab.

Private Sub Command3_Click()
    Dim user_excel_fldr As String
    Dim tbldef As TableDef

    ' CALL FUNCTION
    user_excel_fldr = GetExcelFolder()
    If user_excel_fldr = "" Then Exit Sub

    ' LOOP THROUGH ALL TABLE NAMES
    For Each tbldef In CurrentDb.TableDefs    
        If Not tbldef.Name Like "*MSys*"    ' AVOID SYSTEM TABLES
           DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, tbldef.Name, _
               user_excel_fldr & "\" & "ExcelOutput.xlsx", True, tbldef.Name & "!"
        End If
    Next tbldef

    Set tbldef = Nothing
End Sub

By the way, do note Excel is not a database. Having to dump an entire MS Access database into an Excel workbook even entire tables may require reconsideration. Maybe your users need tailored and filtered tables or queries (i.e., QueryDefs). Best practice is to use Excel as the end-use report application and Access as central repository backend.

Export data from Excel to Access using VBA in Microsoft Excel ERROR

What @Comintern says can be explained this way.

Wrap your string variables in escaped double quotes or single quotes

Like this

  stSQL = "INSERT INTO Client (FullName, Address) " & _
          "Values (""" & Name & """, """ & Address & """)"

Or this

  stSQL = "INSERT INTO Client (FullName, Address) " & _
          "Values ('" & Name & "', '" & Address & "')"

As as side note,

it's highly advisable to change your "NAME" variable to something
else, as that is a reserved word in VB/VBA

---

Related Topics