Append Data to Access Table from Excel

Macro to export Excel range to Access table

Sub export_data()
    ' table to insert, workbook ,range to export
    Call insert_data("tbl_sample", ThisWorkbook, Sheet1.Range("a1:b9"))
End Sub


Sub insert_data(tablename As String, wkb As Workbook, rng As Range)

    Dim cnn As object
    Dim workbookname As String
    Dim sqlstring As String
    Dim rngtoinsert As String
    Dim dbpath As String
    Dim columnnames As String
    Dim columncounter As Integer
    
    Set cnn = CreateObject("ADODB.Connection")

    dbpath = ThisWorkbook.Path & "\database.accdb"
    workbookname = wkb.FullName
    rngtoinsert = "[" & rng.Parent.Name & "$" & rng.Address(0, 0) & "]"
    
    ' extract column/field names
    For columncounter = 1 To rng.Columns.Count
        columnnames = columnnames & "[" & rng.Cells(1, columncounter).Value & "],"
    Next
    columnnames = Left(columnnames, Len(columnnames) - 1)
    
    ' create connection
    cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath
    cnn.Open cnn

    ' add data to access table
    sqlstring = "INSERT INTO " & tablename & "(" & columnnames & ") "
    sqlstring = sqlstring & "SELECT * FROM [Excel 12.0;HDR=YES;DATABASE=" & workbookname & "]." & rngtoinsert
    
    ' execute command and close connection
    cnn.Execute sqlstring
    cnn.Close


End Sub