505.369.1650 [email protected]

Microsoft Access to Microsoft Excel

Microsoft Access provides several ways to export tables and queries to Microsoft Excel.  Each object that gets exported creates one Excel file with a single worksheet.  You can use the VBA function below to combine multiple files into one Excel workbook.

In the example, there are two different methods used to export a Microsoft Access object to Excel.  The DoCmd.OutputTo method works with multiple types of objects (including reports), and it exports some object formatting with it.  The DoCmd.TransferSpreadsheet method is used specifically for tables and queries and does not export formatting.  The HasFieldNames argument is set to True so that the field names appear in the first row of the export.  The example adds the export file names to an array, and then passes that array to the function.


    Dim avarExcelFiles(1)
    Dim strFileName As String
    strFileName = "D:\Code Test\EmployeeTime.xlsx"
    DoCmd.OutputTo acOutputQuery, "qryEmployeeTime", acFormatXLSX, strFileName, False
    avarExcelFiles(0) = "D:\Code Test\EmployeeTime.xlsx"
    strFileName = "D:\Code Test\EmployeeHoursAndMinutes.xlsx"
    DoCmd.TransferSpreadsheet acExport, , "qryEmployeeHoursAndMinutes", strFileName, True
    avarExcelFiles(1) = "D:\Code Test\EmployeeHoursAndMinutes.xlsx"

    ' Call the function that combines the exported files and show the results.
    CombineExcel avarExcelFiles, "D:\Code Test\Timesheet.xlsx", False

The function assumes that there is one worksheet in each exported Excel file.  It uses late binding so that it is not necessary to have an explicit reference to a particular Microsoft Excel object library.


Public gxlsApp As Object

Public Function CombineExcel(ExcelFiles(), FileName As String, _
    CloseFile As Boolean) As Boolean
' This procedure combines all of the Excel files in the ExcelFile array
' into the FileName workbook, each as a separate worksheet.  Then
' it deletes the files in the array. It assumes that there is only one
' worksheet in each of the Excel files.
' CombineExcel() Version 1.0.0
' Copyright © 2023 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.
On Error GoTo Err_Handler

    Dim strFile As String
    Dim xlsWBFinal As Object
    Dim xlsWB As Object
    Dim xlsWS As Object
    Dim lngElem As Long
    Dim strWS As String
    ' Create an Excel app.
    Set gxlsApp = CreateObject("Excel.Application")
    gxlsApp.Visible = False
    ' Open the first file and get a reference to the workbook.
    strFile = ExcelFiles(0)
    gxlsApp.Workbooks.Open strFile
    Set xlsWBFinal = gxlsApp.ActiveWorkbook
    ' Get the name of the worksheet.
    strWS = xlsWBFinal.ActiveSheet.Name
    ' Loop though the rest of the Excel files.
    If UBound(ExcelFiles) > 0 Then
        For lngElem = 1 To UBound(ExcelFiles)
            ' Open the file and get a reference to the workbook and worksheet.
            Set xlsWB = gxlsApp.Workbooks.Open(ExcelFiles(lngElem))
            Set xlsWS = xlsWB.ActiveSheet
            ' Copy the worksheet to the original workbook.
            xlsWS.Copy After:=xlsWBFinal.Sheets(strWS)
            ' Get the name of the current worksheet.
            strWS = xlsWS.Name
            ' Close the workbook.
        Next lngElem
    End If

    ' If the FileName already exists, delete it.
    Kill FileName

    ' Select the first worksheet, cell A1.

    ' Save the orginal workbook to the FileName.
    xlsWBFinal.SaveAs FileName

    ' Delete the other files.
    For lngElem = 0 To UBound(ExcelFiles)
        Kill ExcelFiles(lngElem)
    Next lngElem

    CombineExcel = True

    On Error Resume Next
    If CloseFile Then
        gxlsApp.Visible = True
    End If
    Set gxlsApp = Nothing
    Set xlsWB = Nothing
    Set xlsWS = Nothing
    Set xlsWBFinal = Nothing
    Exit Function

    Select Case Err.Number
    Case 53
        ' File does not exist.
        Resume Next
    Case Else
        MsgBox Err.Number & " " & Err.Description, vbCritical, "CombineExcel()"
        Resume Exit_Proc
    End Select
End Function