在 Access VBA 中更新 Excel Application.StatusBar

Question

我现在的情况：

我正在开发一个嵌入 Excel 文件（名为“Dashboard.xlsm”和访问文件“Dashboard.accdb”）的 VBA 程序的巅峰之作。这两个文件通过 VBA 相互通信，以帮助我对需要为我的公司分析的数据进行一些繁重的工作。因为这些程序正在分发给几个在 3 秒内未完成某事时会惊慌失措的经理，所以我需要一种好的方法来指示正在通过 Excel 在 Access 中运行的 SQL 查询的进度（因为 Access 在背景）。

我当前的 Excel 代码：

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

我当前的访问代码：

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

我的要求：

有没有一种方法可以从 Access 的“for”循环中调用 Application.DisplayStatusBar 并传递正在运行的查询的名称？

或者，我可以通过哪些其他方式显示此信息？

谢谢！！

Answer 1

您有几个选项可以实现这一目标，但最明显的两个是：

1. 从 Excel 执行查询，并更新状态栏从 Excel
2. 执行来自 Access 的查询，但将 Excel 应用程序引用传递给 Access，以便 Access 可以回调 Excel 状态栏。

由于您正在从 Excel 驱动活动，并且您已经引用了 Access 应用程序，因此第一个选项是最合乎逻辑的。第二种方法是可能的 - 您只需将 Excel 对象传递给 Access，然后您将使用 Excel 来自动化 Access 以自动化 Excel。

您需要将 generateFRMPReport_Access 过程从 Access VBA 移动到 Excel VBA，并修改您对 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