Access VBA – Import / Export Excel – Query, Report, Table, and Forms
Written by
Reviewed by
This tutorial will cover the ways to import data from Excel into an Access Table and ways to export Access objects (Queries, Reports, Tables, or Forms) to Excel.
Import Excel File Into Access
To import an Excel file to Access, use the acImport option of DoCmd.TransferSpreadsheet :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:\Temp\Book1.xlsx", True
Or you can use DoCmd.TransferText to import a CSV file:
DoCmd.TransferText acLinkDelim, , "Table1", "C:\Temp\Book1.xlsx", True
Import Excel to Access Function
This function can be used to import an Excel file or CSV file into an Access Table:
Public Function ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean
' Example usage: call ImportFile ("Select an Excel File", "Excel Files", "*.xlsx", "C:\" , True,True, "ExcelImportTest", True, True,false,True)
On Error GoTo err_handler
If (Right(Filename, 3) = "xls") Or ((Right(Filename, 4) = "xlsx")) Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames
End If
If (Right(Filename, 3) = "csv") Then
DoCmd.TransferText acLinkDelim, , TableName, Filename, True
End If
Exit_Thing:
'Clean up
'Check if our linked in Excel table already exists... and delete it if so
If ObjectExists("Table", TableName) = True Then DropTable (TableName)
Set colWorksheets = Nothing
Exit Function
err_handler:
If (Err.Number = 3086 Or Err.Number = 3274 Or Err.Number = 3073) And errCount < 3 Then
errCount = errCount + 1
ElseIf Err.Number = 3127 Then
MsgBox "The fields in all the tabs are the same. Please make sure that each sheet has the exact column names if you wish to import mulitple", vbCritical, "MultiSheets not identical"
ImportFile = False
GoTo Exit_Thing
Else
MsgBox Err.Number & " - " & Err.Description
ImportFile = False
GoTo Exit_Thing
Resume
End If
End Function
You can call the function like this:
Private Sub ImportFile_Example()
Call VBA_Access_ImportExport.ImportFile("C:\Temp\Book1.xlsx", True, "Imported_Table_1")
End Sub
Access VBA Export to New Excel File
To export an Access object to a new Excel file, use the DoCmd.OutputTo method or the DoCmd.TransferSpreadsheet method:
Export Query to Excel
This line of VBA code will export a Query to Excel using DoCmd.OutputTo:
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:\temp\ExportedQuery.xls"
Or you can use the DoCmd.TransferSpreadsheet method instead:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:\temp\ExportedQuery.xls", True
Note: This code exports to XLSX format. Instead you can update the arguments to export to a CSV or XLS file format instead (ex. acFormatXLSX to acFormatXLS).
Export Report to Excel
This line of code will export a Report to Excel using DoCmd.OutputTo:
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c:\temp\ExportedReport.xls"
Or you can use the DoCmd.TransferSpreadsheet method instead:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:\temp\ExportedReport.xls", True
Export Table to Excel
This line of code will export a Table to Excel using DoCmd.OutputTo:
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:\temp\ExportedTable.xls"
Or you can use the DoCmd.TransferSpreadsheet method instead:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:\temp\ExportedTable.xls", True
Export Form to Excel
This line of code will export a Form to Excel using DoCmd.OutputTo:
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:\temp\ExportedForm.xls"
Or you can use the DoCmd.TransferSpreadsheet method instead:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:\temp\ExportedForm.xls", True
Export to Excel Functions
These one line commands work great to export to a new Excel file. However, they will not be able to export into an existing workbook. In the section below we introduce functions that allow you to append your export to an existing Excel file.
Below that, we’ve included some additional functions to export to new Excel files, including error handling and more.
Export to Existing Excel File
The above code examples work great to export Access objects to a new Excel file. However, they will not be able to export into an existing workbook.
To export Access objects to an existing Excel workbook we’ve created the following function:
Public Function AppendToExcel(strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String)
Dim rst As DAO.Recordset
Dim ApXL As Excel.Application
Dim xlWBk As Excel.Workbook
Dim xlWSh As Excel.Worksheet
Dim intCount As Integer
Const xlToRight As Long = -4161
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
Const xlContinuous As Long = 1
Select Case strObjectType
Case "Table", "Query"
Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
Case "Form"
Set rst = Forms(strObjectName).RecordsetClone
Case "Report"
Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
End Select
If rst.RecordCount = 0 Then
MsgBox "No records to be exported.", vbInformation, GetDBTitle
Else
On Error Resume Next
Set ApXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set ApXL = CreateObject("Excel.Application")
End If
Err.Clear
ApXL.Visible = False
Set xlWBk = ApXL.Workbooks.Open(strFileName)
Set xlWSh = xlWBk.Sheets.Add
xlWSh.Name = Left(strSheetName, 31)
xlWSh.Range("A1").Select
Do Until intCount = rst.fields.Count
ApXL.ActiveCell = rst.fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
With ApXL
.Range("A1").Select
.Range(.Selection, .Selection.End(xlToRight)).Select
.Selection.Interior.Pattern = xlSolid
.Selection.Interior.PatternColorIndex = xlAutomatic
.Selection.Interior.TintAndShade = -0.25
.Selection.Interior.PatternTintAndShade = 0
.Selection.Borders.LineStyle = xlNone
.Selection.AutoFilter
.Cells.EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
.Range("B2").Select
.ActiveWindow.FreezePanes = True
.ActiveSheet.Cells.Select
.ActiveSheet.Cells.WrapText = False
.ActiveSheet.Cells.EntireColumn.AutoFit
xlWSh.Range("A1").Select
.Visible = True
End With
'xlWB.Close True
'Set xlWB = Nothing
'ApXL.Quit
'Set ApXL = Nothing
End If
End Function
You can use the function like this:
Private Sub AppendToExcel_Example()
Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet", "C:\Temp\Test.xlsx")
End Sub
Notice you are asked to define:
- What to Output? Table, Report, Query, or Form
- Object Name
- Output Sheet Name
- Output File Path and Name.
Export SQL Query to Excel
Instead you can export an SQL query to Excel using a similar function:
Public Function AppendToExcelSQLStatemet(strsql As String, strSheetName As String, strFileName As String)
Dim strQueryName As String
Dim ApXL As Excel.Application
Dim xlWBk As Excel.Workbook
Dim xlWSh As Excel.Worksheet
Dim intCount As Integer
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
Const xlVAlignCenter = -4108
Const xlContinuous As Long = 1
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
strQueryName = "tmpQueryToExportToExcel"
If ObjectExists("Query", strQueryName) Then
CurrentDb.QueryDefs.Delete strQueryName
End If
Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql)
Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset)
If rst.RecordCount = 0 Then
MsgBox "No records to be exported.", vbInformation, GetDBTitle
Else
On Error Resume Next
Set ApXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set ApXL = CreateObject("Excel.Application")
End If
Err.Clear
ApXL.Visible = False
Set xlWBk = ApXL.Workbooks.Open(strFileName)
Set xlWSh = xlWBk.Sheets.Add
xlWSh.Name = Left(strSheetName, 31)
xlWSh.Range("A1").Select
Do Until intCount = rst.fields.Count
ApXL.ActiveCell = rst.fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
With ApXL
.Range("A1").Select
.Range(.Selection, .Selection.End(xlToRight)).Select
.Selection.Interior.Pattern = xlSolid
.Selection.Interior.PatternColorIndex = xlAutomatic
.Selection.Interior.TintAndShade = -0.25
.Selection.Interior.PatternTintAndShade = 0
.Selection.Borders.LineStyle = xlNone
.Selection.AutoFilter
.Cells.EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
.Range("B2").Select
.ActiveWindow.FreezePanes = True
.ActiveSheet.Cells.Select
.ActiveSheet.Cells.WrapText = False
.ActiveSheet.Cells.EntireColumn.AutoFit
xlWSh.Range("A1").Select
.Visible = True
End With
'xlWB.Close True
'Set xlWB = Nothing
'ApXL.Quit
'Set ApXL = Nothing
End If
End Function
Called like this:
Private Sub AppendToExcelSQLStatemet_Example()
Call VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASheet", "C:\Temp\Test.xlsx")
End Sub
Where you are asked to input:
- SQL Query
- Output Sheet Name
- Output File Path and Name.
Function to Export to New Excel File
These functions allow you to export Access objects to a new Excel workbook. You might find them more useful than the simple single lines at the top of the document.
Public Function ExportToExcel(strObjectType As String, strObjectName As String, Optional strSheetName As String, Optional strFileName As String)
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim intCount As Integer
Const xlToRight As Long = -4161
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
Const xlContinuous As Long = 1
On Error GoTo ExportToExcel_Err
DoCmd.Hourglass True
Select Case strObjectType
Case "Table", "Query"
Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
Case "Form"
Set rst = Forms(strObjectName).RecordsetClone
Case "Report"
Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
End Select
If rst.RecordCount = 0 Then
MsgBox "No records to be exported.", vbInformation, GetDBTitle
DoCmd.Hourglass False
Else
On Error Resume Next
Set ApXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set ApXL = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo ExportToExcel_Err
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = False
Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 31)
End If
xlWSh.Range("A1").Select
Do Until intCount = rst.fields.Count
ApXL.ActiveCell = rst.fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
With ApXL
.Range("A1").Select
.Range(.Selection, .Selection.End(xlToRight)).Select
.Selection.Interior.Pattern = xlSolid
.Selection.Interior.PatternColorIndex = xlAutomatic
.Selection.Interior.TintAndShade = -0.25
.Selection.Interior.PatternTintAndShade = 0
.Selection.Borders.LineStyle = xlNone
.Selection.AutoFilter
.Cells.EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
.Range("B2").Select
.ActiveWindow.FreezePanes = True
.ActiveSheet.Cells.Select
.ActiveSheet.Cells.WrapText = False
.ActiveSheet.Cells.EntireColumn.AutoFit
xlWSh.Range("A1").Select
.Visible = True
End With
retry:
If FileExists(strFileName) Then
Kill strFileName
End If
If strFileName <> "" Then
xlWBk.SaveAs strFileName, FileFormat:=56
End If
rst.Close
Set rst = Nothing
DoCmd.Hourglass False
End If
ExportToExcel_Exit:
DoCmd.Hourglass False
Exit Function
ExportToExcel_Err:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
DoCmd.Hourglass False
Resume ExportToExcel_Exit
End Function
The function can be called like this:
Private Sub ExportToExcel_Example()
Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet")
End Sub