Updating Excel Application.StatusBar within Access VBA - sql

Question

My current situation:
I am developing a culmination of VBA programs embedded in an excel file (named "Dashboard.xlsm" and an access file "Dashboard.accdb"). These two files talk to one another via VBA in order to help me do some heavy lifting on data that I need to analyze for my company. Because these programs are being distributed to several managers who panic when something doesn't complete within 3 seconds, I need a good way to indicate the progress of the SQL queries that are being run in Access through Excel (because Access is running invisibly in the background).
My current Excel code:
Sub generateFRMPComprehensive_ButtonClick(Optional sheetName As Variant)
Application.ScreenUpdating = False
Dim directoryPath As String
Dim cn As Object
Dim rs As Object
Dim strCon As String
Dim strSQL, strInput As String
Dim sArray As Variant
Dim appAccess As Access.Application
Dim directoryName
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
directoryName = Application.ActiveWorkbook.Path
directoryPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Dashboard Exports"
Application.ScreenUpdating = False
If IsMissing(sheetName) Then
sheetName = Application.InputBox("Sheet Name?", "Sheet Selection")
If sheetName = "False" Then
Exit Sub
Else
End If
If FileFolderExists(directoryPath) = 0 Then
Application.StatusBar = "Creating Export Folder"
MkDir directoryPath
End If
End If
'-- Set the workbook path and name
reportWorkbookName = "Report for " & sheetName & ".xlsx"
reportWorkbookPath = directoryPath & "\" & reportWorkbookName
'-- end set
'-- Check for a report already existing
If FileExists(reportWorkbookPath) = True Then
Beep
alertBox = MsgBox(reportWorkbookName & " already exists in " & directoryPath & ". Do you want to replace it?", vbYesNo, "File Exists")
If alertBox = vbYes Then
Kill reportWorkbookPath
'-- Run the sub again with the new sheetName, exit on completion.
generateFRMPComprehensive_ButtonClick (sheetName)
Exit Sub
ElseIf alertBox = vbNo Then
Exit Sub
ElseIf alertBox = "False" Then
Exit Sub
End If
End If
'-- End check
'- Generate the report
'-- Create new access object
Set appAccess = New Access.Application
'-- End Create
'-- Open the acces project
Application.StatusBar = "Updating Access DB"
Call appAccess.OpenCurrentDatabase(directoryName & "\Dashboard.accdb")
appAccess.Visible = False
'-- End open
'-- Import New FRMP Data
Application.StatusBar = "Running SQL Queries"
appAccess.Application.Run "CleanFRMPDB", sheetName, directoryName & "\Dashboard.xlsm"
'-- End Import
Workbooks.Add
ActiveWorkbook.SaveAs "Report for " & sheetName
ActiveWorkbook.Close
appAccess.Application.Run "generateFRMPReport_Access", reportWorkbookPath
Workbooks.Open (reportWorkbookPath)
End Sub
My current Access Code:
Public Sub generateFRMPReport_Access(excelReportFileLocation As String)
Dim queriesList As Variant
queriesList = Array("selectAppsWithNoHolds", _
"selectAppsWithPartialHolds", _
"selectAppsCompleted", _
"selectAppsCompletedEPHIY", _
"selectAppsByDivision", _
"selectAppsByGroup", _
"selectAppsEPHIY", _
"selectAppsEPHIN", _
"selectAppsEPHIYN", _
"selectApps")
For i = 0 To 9
DoCmd.TransferSpreadsheet acExport, , queriesList(i), _
excelReportFileLocation, True
Next i
End Sub
My Request:
Is there a way that I can call the Application.DisplayStatusBar from within the 'for' loop within Access and pass the name of the query being run?
Alternatively, what other ways could I display this information?
Thank you!!

Answer 1

You have a few options for achieving this, but the two most obvious are to:
Execute the queries from Excel, and update the status bar from Excel
Execute the queries from Access, but pass the Excel Application reference to Access, so that Access can call back to the Excel status bar.
As your'e driving the activity from Excel, and you already have a reference to the Access Application, the first option is the most logical. The second approach is possible - you just need to pass the Excel object to Access, but then you'd be using Excel to automate Access to automate Excel.
You'll need to move the generateFRMPReport_Access procedure from the Access VBA into the Excel VBA, and modify your call to the procedure in generateFRMPComprehensive_ButtonClick
Sub generateFRMPComprehensive_ButtonClick(Optional sheetName As Variant)
'...
'appAccess.Application.Run "generateFRMPReport_Access", reportWorkbookPath
generateFRMPReport_Access reportWorkbookPath, appAccess
'...
End Sub
Public Sub generateFRMPReport_Access(excelReportFileLocation As String, appAccess As Access.Application)
Dim queriesList As Variant
Dim i As Long
queriesList = Array("selectAppsWithNoHolds", _
"selectAppsWithPartialHolds", _
"selectAppsCompleted", _
"selectAppsCompletedEPHIY", _
"selectAppsByDivision", _
"selectAppsByGroup", _
"selectAppsEPHIY", _
"selectAppsEPHIN", _
"selectAppsEPHIYN", _
"selectApps")
Application.DisplayStatusBar = True
For i = 0 To 9
Application.StatusBar = "Running query " & (i + 1) & " of 9"
appAccess.DoCmd.TransferSpreadsheet acExport, , queriesList(i), _
excelReportFileLocation, True
Next i
Application.StatusBar = False
Application.DisplayStatusBar = False
End Sub