Progress / Status Meter for Query Export to Excel

Hi All,

Currently I have code that exports a query result to an excel sheet.  My problem is that sometimes this export can take lots of time.  I would like if I can give the user some kind of status saying that it is still working or an actual progress meter with 0%-100% would be even better.  Any Suggestions?

 The code is as follows:

'*********** FORM CODE
Private Sub Command29_Click()
Dim strSQL As String
Dim strDateIn As String, strDateEnd As String

strDateIn = "#" & Me.tbSTARTDATE & "#"
strDateEnd = "#" & Me.tbENDDATE & "#"

If "" & strDateIn = "" Then  ' Is null or zero length
    MsgBox "YOU MUST ENTER A VALUE IN BOTH FIELDS", vbCritical
        Exit Sub
End If
If "" & strDateEnd = "" Then  ' Is null or zero length
    MsgBox "YOU MUST ENTER A VALUE IN BOTH FIELDS", vbCritical
        Exit Sub
End If

strSQL = "SELECT [tblDieLevelInfo].[LotID], [tblDieLevelInfo].[WaferID], [tblDieLevelInfo].[DieID], [qryCrossIL].[TestType], [qryCrossPDL].[DateTimeTested], [qryCrossIL].[5] AS [Max IL Ch5], [qryCrossIL].[6] AS [Max IL Ch6], [qryCrossIL].[7] AS [Max IL Ch7], [qryCrossIL].[8] AS [Max IL Ch8], [qryCrossPDL].[5] AS [Max PDL Ch5], [qryCrossPDL].[6] AS [Max PDL Ch6], [qryCrossPDL].[7] AS [Max PDL Ch7], [qryCrossPDL].[8] AS [Max PDL Ch8] " _
& " FROM (((tblDieLevelInfo INNER JOIN tblDieStepDetailsData ON [tblDieLevelInfo].[DieLevelID]=[tblDieStepDetailsData].[DieLevelID]) INNER JOIN tblDieOpticalTestResultsPassive ON [tblDieStepDetailsData].[DieStepDetailsID]=[tblDieOpticalTestResultsPassive].[DieStepDetailsID]) INNER JOIN qryCrossIL ON [tblDieStepDetailsData].[DieStepDetailsID]=[qryCrossIL].[DieStepDetailsID]) INNER JOIN qryCrossPDL ON [tblDieStepDetailsData].[DieStepDetailsID]=[qryCrossPDL].[DieStepDetailsID]" _
& " GROUP BY [tblDieStepDetailsData].[DieStepDetailsID], [tblDieLevelInfo].[LotID], [tblDieLevelInfo].[WaferID], [tblDieLevelInfo].[DieID], [qryCrossIL].[TestType], [qryCrossPDL].[DateTimeTested], [qryCrossIL].[5], [qryCrossIL].[6], [qryCrossIL].[7], [qryCrossIL].[8], [qryCrossPDL].[5], [qryCrossPDL].[6], [qryCrossPDL].[7], [qryCrossPDL].[8] " _
& " HAVING (((qryCrossIL.TestType)=""Passive test post arc"") AND ((qryCrossPDL.DateTimeTested) Between " & strDateIn & "  And " & strDateEnd & ")) " _
& " ORDER BY [tblDieLevelInfo].[LotID], [tblDieLevelInfo].[WaferID], [tblDieLevelInfo].[DieID]; "

' see "module code below" for function "exporttoexcel"
  ExportToExcel strSQL
End Sub

'******** MODULE CODE
Public Function ExportToExcel(pstrSQL As String)
On Error GoTo err_handle
Dim objExcel As Excel.Application
Dim exlBook As Excel.Workbook
Dim exlSheet As Excel.Worksheet
Dim exlRange As Excel.Range

Dim rec As Recordset
Dim DB As Database
Dim fld As Field
Dim intCol As Integer

Set DB = CurrentDb()
Set rec = DB.OpenRecordset(pstrSQL, dbOpenSnapshot)

Set objExcel = New Excel.Application
Set exlBook = objExcel.Workbooks.Add
Set exlSheet = exlBook.Worksheets(1)
Set exlRange = exlSheet.Range("A1")
intCol = 1
For Each fld In rec.Fields
    exlRange.Cells(1, intCol) = fld.Name
    intCol = intCol + 1
Next
Set exlRange = exlSheet.Range("A2")
exlRange.CopyFromRecordset rec

objExcel.Visible = True
objExcel.WindowState = vbMaximizedFocus
objExcel.Cells.EntireColumn.AutoFit
err_handle:
Set exlRange = Nothing
Set exlSheet = Nothing

End Function