在Access VBA中更新Excel Application.StatusBar [英] Updating Excel Application.StatusBar within Access VBA

问题描述

我正在开发嵌入在excel文件(名为"Dashboard.xlsm"和访问文件"Dashboard.accdb")中的VBA程序的高潮.这两个文件通过VBA相互通信，以帮助我对需要为公司分析的数据进行繁重的工作.由于这些程序已分发给几名在3秒内未完成时会惊慌的管理人员，因此，我需要一种很好的方法来指示通过Excel在Access中运行的SQL查询的进度(因为Access在Windows中隐式运行)背景).

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).

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，并传递正在运行的查询的名称?

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?

谢谢！

推荐答案

您可以选择几种方法来实现此目的，但是最明显的两个方法是:

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

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

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.

当您通过Excel进行活动时，并且您已经已经引用了Access Application，因此第一个选项是最合乎逻辑的.第二种方法是可能的-您只需要将Excel对象传递给Access，但是随后您将使用Excel使Access自动化以使Excel自动化.

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.

您需要将generateFRMPReport_Access过程从Access VBA移到Excel VBA，并在generateFRMPComprehensive_ButtonClick

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

这篇关于在Access VBA中更新Excel Application.StatusBar的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！