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 already have one.
Public Function SendTQ2Excel(strTQName As String, Optional strSheetName As String) ' strTQName is the name of the table or query 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 = CurrentDb.OpenRecordset(strTQName) 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 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