Importing Excel worksheet range to Ms Access Table

Question

Good Afternoon,

I have created a Macro that uploads data to a access database ( both on my desktop). The problem is it I keep getting errors when I try to expand the ran

Answer 1

You can use a query instead of iterating through a recordset:

Sub AccessCode()
    Application.ScreenUpdating = False
    Dim db As Database
    Dim rs As DAO.Recordset

    Set db = OpenDatabase("C:\Users\user\Desktop\Test Copy.accdb")
    db.Execute "INSERT INTO [Fact Table] ([GUID], [StageID], etc) " & _
    "SELECT * FROM [SheetName$G:M] " & _
    "IN """ & ActiveWorkbook.FullName & """'Excel 12.0 Macro;HDR=No;'"
End Sub

This has numerous advantages, such as often being faster because you don't have to iterate through all the fields.

If you would trigger the import from Access instead of Excel, you wouldn't even need VBA to execute the query.

Answer 2

Change the rs section to this one:

With rs
    .addnew
    !GUID = Range("g2").Value
    !StageID = Range("h2").Value
    '...etc
    .Update
End With

MSDN source

Use the AddNew method to create and add a new record in the Recordset object named by recordset. This method sets the fields to default values, and if no default values are specified, it sets the fields to Null (the default values specified for a table-type Recordset).

After you modify the new record, use the Update method to save the changes and add the record to the Recordset. No changes occur in the database until you use the Update method.

Edit: This is how your code should look like, when you change the rs section with the code above:

Sub AccessCode()

    Application.ScreenUpdating = False

    Dim db As Database
    Dim rs As DAO.Recordset

    Set db = OpenDatabase("C:\Users\user\Desktop\Test Copy.accdb")
    Set rs = db.OpenRecordset("Fact Table", dbOpenTable)
    
    With rs
        .addnew
        !GUID = Range("g2").Value
        !StageID = Range("h2").Value
        '...etc
        .Update
        .Close
    End With

    Application.ScreenUpdating = True
    MsgBox " Upload To PMO Database Successful."

End Sub

Answer 3

Just thought I'd add in an alternative to @Erik von Asmuth's excellent answer. I use something like this in a real project. It's a little more robust for importing a dynamic range.

Public Sub ImportFromWorksheet(sht As Worksheet)

    Dim strFile As String, strCon As String

    strFile = sht.Parent.FullName

    strCon = "Excel 12.0;HDR=Yes;Database=" & strFile

    Dim strSql As String, sqlTransferFromExcel As String

    Dim row As Long
    row = sht.Range("A3").End(xlDown).row
    Dim rng As Range

    sqlTransferFromExcel = " Insert into YourTable( " & _
                " [GUID] " & _
                " ,StageID " & _
                " ,[sync Date] " & _
                " ,[etc...] " & _
                " ) " & _
                " SELECT [GUID] " & _
                " ,StageID " & _
                " ,[sync Date] " & _
                 " ,[etc...] " & _
                " FROM [{{connString}}].[{{sheetName}}$G2:M{{lastRow}}]"

    sqlTransferFromExcel = Replace(sqlTransferFromExcel, "{{lastRow}}", row)
    sqlTransferFromExcel = Replace(sqlTransferFromExcel, "{{connString}}", strCon)
    sqlTransferFromExcel = Replace(sqlTransferFromExcel, "{{sheetName}}", sht.Name)

    CurrentDb.Execute sqlTransferFromExcel

End Sub