Copy this code into a standard (not form or report) module. Name the module something other than this function name and make sure to set a reference to DAO if you don’t have one set already.
You can then call it like this for a form (if the code is on the form you want then):
Call Send2Excel(Me, "SheetNameHereInQuotes")
To use it with a form which the code is not on use (the form must be open):
Call Send2Excel(Forms!YourFormNameHere, "SheetNameInQuotes")
To use it with a subform and the code not be on the subform:
'if code is on the main form: Call Send2Excel(Me.SubformControl.Form, "SheetNameInQuotes")
'if code is on a completely different form: Call Send2Excel(Forms!YourMainFormName.SubformControl.Form, "SheetNameInQuotes")
Just a note – SubformControl means the control on the main form which houses the subform and not the subform name itself (unless they share the same name).
Public Function Send2Excel(frm As Form, Optional strSheetName As String) ' frm is the name of the form you want to send to Excel ' strSheetName is the name of the sheet you want to name it to Dim rst As DAO.Recordset Dim ApXL As Object Dim xlWBk As Object Dim xlWSh As Object Dim fld As DAO.Field Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 On Error GoTo err_handler Set rst = frm.RecordsetClone Set ApXL = CreateObject("Excel.Application") Set xlWBk = ApXL.Workbooks.Add ApXL.Visible = True Set xlWSh = xlWBk.Worksheets("Sheet1") If Len(strSheetName) > 0 Then xlWSh.Name = Left(strSheetName, 34) End If xlWSh.Activate xlWSh.Range("A1").Select For Each fld In rst.Fields ApXL.ActiveCell = fld.Name ApXL.ActiveCell.Offset(0, 1).Select Next rst.MoveFirst xlWSh.Range("A2").CopyFromRecordset rst xlWSh.Range("1:1").Select ' This is included to show some of what you can do about formatting. 'You can comment out or delete ' any of this below that you don't want to 'use in your own export. With ApXL.Selection.Font .Name = "Arial" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False End With ApXL.Selection.Font.Bold = True With ApXL.Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .MergeCells = False End With ' selects all of the cells ApXL.ActiveSheet.Cells.Select ' does the "autofit" for all columns ApXL.ActiveSheet.Cells.EntireColumn.AutoFit ' selects the first cell to unselect all cells xlWSh.Range("A1").Select rst.Close Set rst = Nothing Exit Function err_handler: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number Exit Function End Function