dim s as string
' sCrit is the criteria that I'm guessing your command button creates to filter your data
s = "SELECT Field1 as [User Friendly Column Heading], Field2 AS [Another Column Heading] FROM YourTableOrQuery WHERE " & sCrit
If GenericExcelReport(s, "My Excel Report Title") = true then
msgbox "Export Done"
Else
msgbox "Export Failed"
end if
' Place this code in a separate module named modExcelExports
Function GenericExcelReport(sSelect As String, sTitle As String) As Boolean
'On Error GoTo ErrGenericExcelReport
Const xlTop As Integer = -4160
GenericExcelReport = False
Dim db As Database
Dim rsGeneric As DAO.Recordset
Set db = CurrentDb
Set rsGeneric = db.OpenRecordset(sSelect, dbOpenDynaset, dbSeeChanges)
Dim ColCount As Integer
Dim col As Integer
Dim row As Integer
'Dim oExcel As Excel.Application
'Dim oWB As Excel.Workbook
'Dim oWS As Excel.Worksheet
Dim oExcel As Object
Dim oWB As Object
Dim oWS As Object
'open the spreadsheet for editing
'On Error GoTo Excel_EH
If oExcel Is Nothing Then Set oExcel = CreateObject("Excel.Application") 'New Excel.Application
oExcel.Visible = True
Set oWB = oExcel.Workbooks.Add
Set oWS = oExcel.ActiveSheet
'On Error GoTo ErrGenericExcelReport
DoEvents
ColCount = rsGeneric.Fields.Count
row = 1
col = 0
With oWS
If (sTitle & "" <> "") Then row = row + 2 'set up for the title if there is one
.rows(row).Font.Bold = True
'set up the Column Headings and
Do While (col < ColCount)
.cells(row, col + 1).Value = rsGeneric.Fields(col).Name
'check if this field type is Date/Time
If rsGeneric.Fields(col).Type = 8 Then
'next line requires more checking, the property may not exist for each date field
'If (rsGeneric.Fields(col).Properties("Format") = "Short Date") then .Columns(col + 1).NumberFormat = "m/d/yyyy;@"
.Columns(col + 1).NumberFormat = "[$-409]yyyy-mm-dd"
End If
'check if this field type is Currency
If rsGeneric.Fields(col).Type = 5 Then
.Columns(col + 1).NumberFormat = "$#,##0.00"
End If
col = col + 1
Loop
'output the data
If rsGeneric.EOF Then
row = row + 1
col = 0
.cells(row, col + 1).Value = "There are no records to display."
.range(.cells(row, col + 1), .cells(row, ColCount)).merge
End If
Do While Not rsGeneric.EOF
row = row + 1
col = 0
Do While (col < ColCount)
.cells(row, col + 1).Value = rsGeneric.Fields(col)
col = col + 1
Loop
rsGeneric.MoveNext
Loop
.cells.EntireColumn.AutoFit
.cells.EntireRow.AutoFit
.cells.EntireRow.VerticalAlignment = xlTop
If (sTitle & "" <> "") Then
row = 1
col = 0
.rows(row).Font.Bold = True
.cells(row, col + 1).Value = sTitle
.cells(row, col + 1).WrapText = False
.cells(row, col + 1).Font.Size = 14
End If
End With
GenericExcelReport = True
Exit Function
Excel_EH:
DoEvents
DoEvents
MsgBox "An error occurred. Please close excel and try running the process again.", vbExclamation, "No Page Break Inserted"
Exit Function
ErrGenericExcelReport:
MsgBox "An error occured while attempting to generate the report." & vbCrLf & Err.Number & ": " & Err.Description
Exit Function
End Function
https://docs.microsoft.com/en-us/office/vba/api/access.docmd.transferspreadsheet