Excel Export to Access

Option Explicit

Dim objConnection As ADODB.Connection
 
Sub ConnectToDatabase(strDBpath As String)
    Set objConnection = New ADODB.Connection
    objConnection.Open "Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=" & strDBpath
End Sub
 
Sub ExportToAccess(rngData As Range, Optional blnHeader As Boolean = False)
    Dim rstTable        As ADODB.Recordset
    Dim lngRow          As Long
    Dim lngCol          As Long
    Dim strDB           As String
    Dim strTable        As String
    Dim intStartRow     As Integer
 
    If blnHeader = False Then
        intStartRow = 1
    Else
        intStartRow = 2
    End If
 
'---------------------User Inputs-------------------------------
'Provide database path
    strDB = "E:\DAS Project w Nate\DASProductivity.accdb"
'Provide SQL Query or Table name from database
    strTable = "test"
'===============================================================
    
'Establish Database connection
On Error GoTo ErrH
    Call ConnectToDatabase(strDB)
 
    Set rstTable = New ADODB.Recordset
    rstTable.Open strTable, objConnection, adOpenKeyset, adLockOptimistic, adCmdTable
 
'Check if No of data columns are same as No. of fields in database
    If rngData.Columns.Count <> rstTable.Fields.Count Then
        MsgBox "No. of columns in data is different from no. of fields in DB table", vbCritical, "Export Error"
        GoTo ExitH
    End If
 
    For lngRow = intStartRow To rngData.Rows.Count
        With rstTable
            .AddNew
            For lngCol = 0 To (.Fields.Count - 1)
                .Fields(lngCol) = rngData.Cells(lngRow, lngCol + 1).Value
            Next lngCol
            .update
        End With
    Next lngRow
On Error GoTo 0
    GoTo ExitH
ErrH:
    If objConnection.State = 1 Then rstTable.CancelUpdate
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Export Error"
ExitH:
    If objConnection.State = 1 Then rstTable.Close
    Set rstTable = Nothing
End Sub
 
Sub CloseDB()
    objConnection.Close
    Set objConnection = Nothing
End Sub

Select allOpen in new window

ErrH:
    If objConnection.State = 1 Then rstTable.CancelUpdate
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Export Error"

Select allOpen in new window

-2147467259 [Microsoft][ODBC Driver Manager]Data source name not found and no default driver specified