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 SendTQ2ExcelNameNewSheet(strTQName As String, 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 your sheet to Dim rst As DAO.Recordset Dim ApXL As Object Dim xlWBk As Object Dim xlWSh As Object Dim fld As DAO.Field Dim strPath As String 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 xlWBk.Worksheets("Sheet1").Name = strSheetName Set xlWSh = xlWBk.Worksheets(strSheetName) xlWSht.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