Updating Excel Application.StatusBar within Access VBA

问题:

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!!

回答1:

You have a few options for achieving this, but the two most obvious are to:

1. Execute the queries from Excel, and update the status bar from Excel
2. 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 

文章来源: Updating Excel Application.StatusBar within Access VBA