How would you cause Excel to generate only 1 customized message box asking the user whether or not to save an Excel file ?

Option Explicit
Public footnote As String
Dim clsMonitor As CExcelMonitor
Private Const strAccessPath0 = "\\AbandonedProperty\UDL\Access\"
Private Const strAccessPath16 = "TA1099Reports\"
Dim intYearSP As Integer
Dim strScreenType As String
 
Private Sub Command852_Click()
    Dim cn As ADODB.Recordset
    Dim ExportedFile As String
    Dim rstQueryFS As ADODB.Recordset
    Dim objXL As Excel.Application
    Dim objWS As Excel.Worksheet
    Dim fld As ADODB.Field
    Dim com As ADODB.Command
    
    txtDateFrom1099.Value = "01/01/2008"
    txtDateTo1099.Value = "06/30/2008"
                   
    Set cn = New ADODB.Recordset
    strScreenType = "A1099"
        
    cn.ActiveConnection = CurrentProject.Connection
    cn.CursorType = adOpenStatic
    cn.CursorLocation = adUseServer
    cn.LockType = adLockReadOnly
               
    DoCmd.Hourglass True
    Set com = New ADODB.Command
    With com
       .CommandType = adCmdStoredProc
       .CommandText = "dbo.procA1099RedFlag"
       .Parameters.Append .CreateParameter("DteFrom", adDate, adParamInput, , CDate(txtDateFrom1099.Value))
       .Parameters.Append .CreateParameter("DteTo", adDate, adParamInput, , CDate(txtDateTo1099.Value))
       .ActiveConnection = CurrentProject.Connection
       Set rstQueryFS = .Execute
    End With
    
    ExportedFile = strAccessPath0 & strAccessPath16 & "REDFLAG" & "_" & intYearSP & "_" & Format(Now, "mmddhhnnss") & ".XLS"
    
    footnote = "This file represents extraction of unique Account Numbers."
    
    DoCmd.TransferSpreadsheet acExport, 8, "dbo.tblA1099RedFlag", ExportedFile, True, ""
    
    MsgBox "Red Flag records have been exported to Excel", vbOKOnly, ""
    
    If isFileExist(ExportedFile) Then StartDocLexNex ExportedFile, footnote, strScreenType, txtDateFrom1099.Value, txtDateTo1099.Value
    
    DoCmd.Hourglass False
End Sub
 
Private Sub Form_Load()
    Dim filename As String
    Dim cn As ADODB.Recordset
              
    DoCmd.Maximize
               
    Set cn = New ADODB.Recordset
  
    cn.ActiveConnection = CurrentProject.Connection
    cn.CursorType = adOpenStatic
    cn.CursorLocation = adUseServer
    cn.LockType = adLockReadOnly
End Sub
 
Private Sub StartDocLexNex(filename, footnote, strScreenType, txtDateFrom, txtDateTo)
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlWS As Excel.Worksheet
 
    Dim intRows As Long
 
    Set xlApp = CreateObject("excel.application")
 
    xlApp.Workbooks.Open (filename)
 
    xlApp.Visible = True
    Set xlWS = xlApp.ActiveWorkbook.Worksheets(1)
    xlWS.Columns.AutoFit
 
    intRows = xlWS.UsedRange.Rows.count
 
    xlWS.Cells(intRows + 5, 1).Value = footnote
 
    xlWS.Cells(intRows + 6, 1).Value = "For the period " & txtDateFrom & " To " & txtDateTo
    xlApp.ScreenUpdating = True
 
    If (MsgBox("Do you want to save the file", vbYesNo)) = vbYes Then
        For Each xlWB In xlApp.Workbooks
            xlWB.Save
        Next xlWB
    End If
 
    With xlApp
        .ScreenUpdating = True
        .DisplayAlerts = 0
        .Workbooks.Close
        .DisplayAlerts = 1
        .Quit
    End With
 
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
 
    Kill filename
End Sub
 
Private Function isFileExist(filePath As String) As Boolean
    isFileExist = (filePath <> "" And Dir$(filePath) <> "")
End Function