Apply filter prior to circling through recordset and copying to spreadsheet (Access 365 version)

Good morning, 

I have a form in my access database which filters data from a query to pull up only information with a user entered numerical field.  Ultimately, I would like the user to be able to enter the number to search in a text box, click to allow the data to be filtered so that only data with that information is presented and then export the result to excel.  

I have the above functional with a DoCmd.ApplyFilter; however, some of the data is stored within a variable which allows rich text format.  Exporting the result to excel after filtering strips this minimal formatting, and sometimes truncates the data.  Following the suggestion provided under 04 - Rich Text formatting is stripped, I have applied the code referenced in the Microsoft Docs article: How to transfer data from an ADO Recordset to Excel with automation.  With some minimal edits, this worked wonderfully to produce a spreadsheet which resolves both of those issues; however, I am only able to output the entire query, not the filtered query result.

How can I edit the code below so that the output is filtered by the value entered in the textbox on the form?

Private Sub Automate_Excel_Click()
' Code adapted from following location: https://docs.microsoft.com/en-US/previous-versions/office/troubleshoot/office-developer/transfer-excel-data-from-ado-recordset , Also used code from https://www.youtube.com/watch?v=7HckYjH_wg4
Dim db As Database
Dim rst As DAO.Recordset

Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object

Dim recArray As Variant

Dim strDB As String
    Dim fldCount As Integer
    Dim recCount As Long
    Dim iCol As Integer
    Dim iRow As Integer

Set db = CurrentDb
Set rst = db.OpenRecordset("qryCorresTracking")




' Create an instance of Excel and add a workbook
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Sheet1")

' Display Excel and give user control of Excel's lifetime
    xlApp.Visible = True
    xlApp.UserControl = True

' Copy field names to the first row of the worksheet
    fldCount = rst.Fields.Count
    For iCol = 1 To fldCount
        xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
    Next

' Check version of Excel
    If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
        'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset

' Copy the recordset to the worksheet, starting in cell A2
        xlWs.Cells(2, 1).CopyFromRecordset rst
        'Note: CopyFromRecordset will fail if the recordset
        'contains an OLE object field or array data such
        'as hierarchical recordsets

Else
        'EXCEL 97 or earlier: Use GetRows then copy array to Excel

' Copy recordset to an array
        recArray = rst.GetRows
        'Note: GetRows returns a 0-based array where the first
        'dimension contains fields and the second dimension
        'contains records. We will transpose this array so that
        'the first dimension contains records, allowing the
        'data to appears properly when copied to Excel

' Determine number of records

recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array

' Check the array for contents that are not valid when
        ' copying the array to an Excel worksheet
        For iCol = 0 To fldCount - 1
            For iRow = 0 To recCount - 1
                ' Take care of Date fields
                If IsDate(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = Format(recArray(iCol, iRow))
                ' Take care of OLE object fields or array fields
                ElseIf IsArray(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = "Array Field"
                End If
            Next iRow 'next record
        Next iCol 'next field



' Transpose and Copy the array to the worksheet,
        ' starting in cell A2
        xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
            TransposeDim(recArray)
    End If

' Auto-fit the column widths and row heights (added additional line to set columns as wrap text.
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Columns.WrapText = True
    xlApp.Selection.CurrentRegion.Rows.AutoFit

' Close ADO objects
    rst.Close
    Set rst = Nothing

' Release Excel references
    Set xlWs = Nothing
    Set xlWb = Nothing

Set xlApp = Nothing

End Sub

Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)

Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant

Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)

ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X

TransposeDim = tempArray

End Function