Very similarly to my MS Access – VBA – Export Records to Excel post, I found myself needing to easily export a form’s recordset to Excel.  Not the underlying table or query, but the filtered, currently viewed recordset.  I already had the above code so I made a few very minor tweaks et voila I had a new function that could export, with ease, any recordset to Excel.  Hopefully it can help someone else!

'---------------------------------------------------------------------------------------
' Procedure : ExportRecordset2XLS
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Export the passed recordset to Excel
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' rs        : Recordset object to export to excel
'
' Usage:
' ~~~~~~
' Call ExportRecordset2XLS(Me.RecordsetClone)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2017-Mar-13             Initial Release
' 2         2018-09-20              Updated Copyright
'---------------------------------------------------------------------------------------
Function ExportRecordset2XLS(ByVal rs As DAO.Recordset)
    '#Const EarlyBind = True 'Use Early Binding, Req. Reference Library
    #Const EarlyBind = False    'Use Late Binding
    #If EarlyBind = True Then
        'Early Binding Declarations
        Dim oExcel            As Excel.Application
        Dim oExcelWrkBk       As Excel.WorkBook
        Dim oExcelWrSht       As Excel.WorkSheet
    #Else
        'Late Binding Declaration/Constants
        Dim oExcel            As Object
        Dim oExcelWrkBk       As Object
        Dim oExcelWrSht       As Object
        Const xlCenter = -4108
    #End If
    Dim bExcelOpened          As Boolean
    Dim iCols                 As Integer

    'Start Excel
    On Error Resume Next
    Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel

    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oExcel = CreateObject("Excel.Application")
        bExcelOpened = False
    Else    'Excel was already running
        bExcelOpened = True
    End If
    On Error GoTo Error_Handler

    oExcel.ScreenUpdating = False
    oExcel.Visible = False   'Keep Excel hidden until we are done with our manipulation
    Set oExcelWrkBk = oExcel.Workbooks.Add()    'Start a new workbook
    Set oExcelWrSht = oExcelWrkBk.Sheets(1)

    With rs
        If .RecordCount <> 0 Then
            .MoveFirst    'This is req'd, had some strange behavior in certain instances without it!
            'Build our Header
            '****************
            For iCols = 0 To rs.Fields.Count - 1
                oExcelWrSht.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
            Next
            'Format the header
            With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                                   oExcelWrSht.Cells(1, iCols))
                .Font.Bold = True
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .HorizontalAlignment = xlCenter
            End With
            'Copy the data from our query into Excel
            '***************************************
            oExcelWrSht.Range("A2").CopyFromRecordset rs

            'Some formatting to make things pretty!
            '**************************************
            'Freeze pane
            oExcelWrSht.Rows("2:2").Select
            With oExcel.ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
                .FreezePanes = True
            End With
            'AutoFilter
            oExcelWrSht.Rows("1:1").AutoFilter
            'Fit the columns to the content
            oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                              oExcelWrSht.Cells(1, iCols)).EntireColumn.AutoFit
            'Start at the top
            oExcelWrSht.Range("A1").Select
        Else
            MsgBox "There are no records returned by the specified queries/SQL statement.", _
                   vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
            GoTo Error_Handler_Exit
        End If
    End With

Error_Handler_Exit:
    On Error Resume Next
    oExcel.Visible = True   'Make excel visible to the user
    Set rs = Nothing
    Set oExcelWrSht = Nothing
    Set oExcelWrkBk = Nothing
    oExcel.ScreenUpdating = True
    Set oExcel = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ExportRecordset2XLS" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

As you can see by examining the code it includes Conditional Compiling Directive so you can have it either as Early or Late Binding to suit your preferences.

Furthermore, the following sections of code are completely optional and are simply used to perform some basic formatting (pretty things up and make the worksheet easier to work with IMHO). I’ve left it in place should it be useful to you and also to illustrate how easily you can perform other automations at the same time as performing the export (show some of the syntax). Feel free to remove it as you see fit.

            'Format the header
            With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                                   oExcelWrSht.Cells(1, iCols))
                .Font.Bold = True
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .HorizontalAlignment = xlCenter
            End With

and

            'Some formatting to make things pretty!
            '**************************************
            'Freeze pane
            oExcelWrSht.Rows("2:2").Select
            With oExcel.ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
                .FreezePanes = True
            End With
            'AutoFilter
            oExcelWrSht.Rows("1:1").AutoFilter
            'Fit the columns to the content
            oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                              oExcelWrSht.Cells(1, iCols)).EntireColumn.AutoFit

Taking Things Even Further :: ExportRecordset2XLS V2.0!

Now the above functions does exactly as intended, but what if we wanted more flexibility and more control over what is applied depending on the situation! This is the beauty of VBA once you truly get into it, you can develop some true coding gems that can be utilized in all sorts of situations.

So let reexamine the above function, how could we modify it to not need to actually remove sections of code depending on whether or not we want autofilters applies, or freeze panes, …? How could we make if flexible enough to even allow the user to specify an exist workbook to export to, and if none is specified then create a new one. How can we make a universal function?

Surprisingly, with a pretty small number of tweak to the above function we can do all that!

'---------------------------------------------------------------------------------------
' Procedure : ExportRecordset2XLS
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Export the passed recordset to Excel
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' rs        : Recordset object to export to excel
' sFile     : Optional -> File path and name to update
'                   If none is provided a new Excel file is created
' sWrkSht   : Optional -> Name of the Worksheet to update
'                   If sWrkSht is supplied and the sheet does not exist it will be
'                   created
' lStartCol : Optional -> Column number to start inserting the data into
'                   If none is supply insert will be start on the 1st Column
' lStartRow : Optional -> Row number to start inserting the data into
'                   If none is supply insert will be start on the 1st Row
' bFitCols  : Optional -> Auto Fit the column to the width of the data contained within
'                   Default is True
' bFreezePanes : Optional -> Freeze the Header row
'                   Default is True
' bAutoFilter  : Optional -> AutoFilter the data
'                   Default is True
'
' Usage:
' ~~~~~~
' Call ExportRecordset2XLS(Me.RecordsetClone)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2017-Mar-13             Initial Release
' 2         2017-Mar-16             Added sFile
'                                   Added sWrkSht
'                                   Added lStartCol
'                                   Added lStartRow
'                                   Added bFitCols
'                                   Added bFreezePanes
'                                   Added bAutoFilter
' 2         2018-09-20              Updated Copyright
'---------------------------------------------------------------------------------------
Function ExportRecordset2XLS(ByVal rs As DAO.Recordset, _
                             Optional ByVal sFile As String, _
                             Optional ByVal sWrkSht As String, _
                             Optional ByVal lStartCol As Long = 1, _
                             Optional ByVal lStartRow As Long = 1, _
                             Optional bFitCols As Boolean = True, _
                             Optional bFreezePanes As Boolean = True, _
                             Optional bAutoFilter As Boolean = True)
    '#Const EarlyBind = True    'Use Early Binding, Req. Reference Library
    #Const EarlyBind = False    'Use Late Binding
    #If EarlyBind = True Then
        'Early Binding Declarations
        Dim oExcel            As Excel.Application
        Dim oExcelWrkBk       As Excel.WorkBook
        Dim oExcelWrkSht      As Excel.WorkSheet
    #Else
        'Late Binding Declaration/Constants
        Dim oExcel            As Object
        Dim oExcelWrkBk       As Object
        Dim oExcelWrkSht      As Object
        Const xlCenter = -4108
    #End If
    Dim bExcelOpened          As Boolean
    Dim iCols                 As Integer
    Dim lWrkBk                As Long

    'Start Excel
    On Error Resume Next
    Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel

    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oExcel = CreateObject("Excel.Application")
        bExcelOpened = False
    Else    'Excel was already running
        bExcelOpened = True
    End If
    On Error GoTo Error_Handler

    oExcel.ScreenUpdating = False
    oExcel.Visible = False   'Keep Excel hidden until we are done with our manipulation

    If sFile <> "" Then
        Set oExcelWrkBk = oExcel.Workbooks.Open(sFile)    'Start a new workbook
        On Error Resume Next
        lWrkBk = Len(oExcelWrkBk.Sheets(sWrkSht).Name)
        If Err.Number <> 0 Then
            oExcelWrkBk.Worksheets.Add.Name = sWrkSht
            Err.Clear
        End If
        On Error GoTo Error_Handler
        Set oExcelWrkSht = oExcelWrkBk.Sheets(sWrkSht)
        oExcelWrkSht.Activate
    Else
        Set oExcelWrkBk = oExcel.Workbooks.Add()    'Start a new workbook
        Set oExcelWrkSht = oExcelWrkBk.Sheets(1)
        If sWrkSht <> "" Then
            oExcelWrkSht.Name = sWrkSht
        End If
    End If

    With rs
        If .RecordCount <> 0 Then
            .MoveFirst    'This is req'd, had some strange behavior in certain instances without it!
            'Build our Header
            '****************
            For iCols = 0 To rs.Fields.Count - 1
                oExcelWrkSht.Cells(lStartRow, lStartCol + iCols).Value = rs.Fields(iCols).Name
            Next
            'Format the header
            With oExcelWrkSht.Range(oExcelWrkSht.Cells(lStartRow, lStartCol), _
                                    oExcelWrkSht.Cells(lStartRow, lStartCol + iCols - 1))
                .Font.Bold = True
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .HorizontalAlignment = xlCenter
            End With
            'Copy the data from our query into Excel
            '***************************************
            oExcelWrkSht.Cells(lStartRow + 1, lStartCol).CopyFromRecordset rs

            'Some formatting to make things pretty!
            '**************************************
            'Freeze pane
            If bFreezePanes = True Then
                oExcelWrkSht.Cells(lStartRow + 1, 1).Select
                oExcel.ActiveWindow.FreezePanes = True
            End If
            'AutoFilter
            If bAutoFilter = True Then
                oExcelWrkSht.Rows(lStartRow & ":" & lStartRow).AutoFilter
            End If
            'Fit the columns to the content
            If bFitCols = True Then
                oExcelWrkSht.Range(oExcelWrkSht.Cells(lStartRow, lStartCol), _
                                   oExcelWrkSht.Cells(lStartRow, lStartCol + iCols)).EntireColumn.AutoFit
            End If
            'Start at the top
            oExcelWrkSht.Cells(lStartRow, lStartCol).Select
        Else
            MsgBox "There are no records returned by the specified queries/SQL statement.", _
                   vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
            GoTo Error_Handler_Exit
        End If
    End With

Error_Handler_Exit:
    On Error Resume Next
    oExcel.Visible = True   'Make excel visible to the user
    Set rs = Nothing
    Set oExcelWrkSht = Nothing
    Set oExcelWrkBk = Nothing
    oExcel.ScreenUpdating = True
    Set oExcel = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ExportRecordset2XLS" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Download

Feel free to download a copy by using the links provided below:

Disclaimer/Notes:

The YouTube Demo File:

The Original Article File:

As requested, feel free to download a fully function sample 2003 mdb of the above code which illustrates how it can be implemented.
Export Recordset To Excel (2K3 mdb)