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.
Example
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", FalseThe 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.
basCombineExcel
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.
xlsWB.Close
Next lngElem
End If
' If the FileName already exists, delete it.
Kill FileName
' Select the first worksheet, cell A1.
xlsWBFinal.Worksheets(1).Activate
xlsWBFinal.Worksheets(1).Range("A1").Select
' 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
Exit_Proc:
On Error Resume Next
If CloseFile Then
xlsWB.Close
xlsWBFinal.Close
gxlsApp.Quit
Else
gxlsApp.Visible = True
End If
Set gxlsApp = Nothing
Set xlsWB = Nothing
Set xlsWS = Nothing
Set xlsWBFinal = Nothing
Exit Function
Err_Handler:
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
Making Microsoft Access Work. Call (505) 369-1650.