Export spreadsheet data to Access
Following macro can be used in Excel VBA to export Excel data into Access.
Sub TestMacro()
Call ExcelToAccessTransferSpreadsheet("G:\ExcelExperts\ExcelAccessTest.mdb", "DBTestTbl", "G:\ExcelExperts\Test.xlsm", "Sheet1", "A1:C8")
End Sub
Sub ExcelToAccessTransferSpreadsheet(strDBPath As String, strDBTableName As String, strExcelFilePath As String, strSheet As String, strRange As String, Optional blnClearTableBfrUpload As Boolean = True, Optional blnDropTableBfrUpload As Boolean = False)
'Should have access on the system
'Creates a new table in Access if not found
Dim acc As Object
Set acc = CreateObject("Access.Application")
On Error GoTo DBErr
acc.OpenCurrentDatabase strDBPath
Err.Clear: On Error GoTo 0: On Error GoTo -1
If blnDropTableBfrUpload = True Then
On Error Resume Next
acc.DoCmd.RunSQL "Drop Table [" & strDBTableName & "]"
Err.Clear: On Error GoTo 0: On Error GoTo -1
Else
If blnClearTableBfrUpload = True Then
On Error Resume Next
acc.DoCmd.RunSQL "Delete * from [" & strDBTableName & "]"
Err.Clear: On Error GoTo 0: On Error GoTo -1
End If
End If
'acc.Visible = True
On Error GoTo ExcelErr
acc.DoCmd.TransferSpreadsheet _
TransferType:=0, _
SpreadSheetType:=10, _
TableName:=strDBTableName, _
Filename:=strExcelFilePath, _
HasFieldNames:=True, _
Range:=strSheet & "!" & strRange '"Sheet1$A1:B8"
Err.Clear: On Error GoTo 0: On Error GoTo -1
acc.CloseCurrentDatabase
acc.Quit
GoTo CleanUp
DBErr:
MsgBox Err.Number & "!" & Err.Description & vbLf & vbLf & "!! Should have MS Access install on your system !!", vbCritical, "DB Access Error"
GoTo CleanUp
ExcelErr:
MsgBox Err.Number & "!" & Err.Description, vbCritical, "Excel File Error"
GoTo CleanUp
CleanUp:
Set acc = Nothing
End Sub
- Vishesh's blog
- Login or register to post comments
- 8955 reads
Recent comments
5 years 36 weeks ago
6 years 22 weeks ago
6 years 34 weeks ago
6 years 37 weeks ago
6 years 38 weeks ago
6 years 43 weeks ago
6 years 52 weeks ago
7 years 2 days ago
7 years 3 days ago
7 years 3 days ago