This procedure was written by Walter Brunell and published in Access Advisor, October 2004.


Private Sub ExportToExcel(strSQL As String)
  On Error GoTo HandleErrors

  Dim response As VbMsgBoxResult

  response = _
     MsgBox("This action may take several minutes." & _
     vbCrLf & "Do you wish to continue...?", _
     vbQuestion + vbOKCancel)
  
  If response = vbOK Then
    DoCmd.Hourglass True

    Dim rs As DAO.Recordset
    Dim xlApp As Excel.Application
    Dim intCol As Integer
    Dim strFileName As String
    
    Set rs = CurrentDb.OpenRecordset(strSQL)
    Set xlApp = New Excel.Application
    xlApp.Workbooks.Add
    
    'Add header row to spreadsheet
    For intCol = 0 To rs.Fields.Count - 1
      xlApp.Cells(1, intCol + 1).Value = _
       rs.Fields(intCol).Name
    Next
    
    'Move data from the local recordset to Excel
    xlApp.Range("A2").CopyFromRecordset rs

    xlApp.Visible = True    'added by Bill Mosca 3/37/2007 so dialog box shows.
    
    strFileName = xlApp.GetSaveAsFilename( _
       "ExcelOutput", _
       fileFilter:="MS Excel Files (*.xls), *.xls")

    'added by Bill Mosca 3/37/2007 so Acc msgbox is visible.
    xlApp.Visible = False       

    If Len(strFileName) > 0 Then
      xlApp.ActiveWorkbook.SaveAs _
         Filename:=strFileName
      MsgBox "File save complete!", vbInformation
    Else
      MsgBox "File save aborted by user!", vbCritical
      xlApp.ActiveWorkbook.Close False
    End If
    
    xlApp.Quit
    
    Set xlApp = Nothing
    Set rs = Nothing
  End If
  
ExitHere:
  DoCmd.Hourglass False
  Exit Sub
  
HandleErrors:
  MsgBox Err.Description
  Resume ExitHere
End Sub

Call the procedure with code like this:

ExportToExcel ("SELECT * FROM MyTable")