操作查询的进度条

Question

我正在运行进行一系列链接到多个后端 table 的操作查询（进行 table 查询）。我想显示一个进度条，因为这些查询总共需要 12 分钟到运行。当我运行代码时，我看到一个沙漏，但看不到进度条。我尝试了下面的代码，但它没有显示进度条。还有其他方法可以显示操作查询的进度吗？

Option Compare Database
Option Explicit

Private Sub PS_Report_Date_AfterUpdate()

Dim intCnt As Integer
intCnt = 0

DoCmd.SetWarnings False

DoCmd.Close acReport, "Report Name", acSavePrompt

' Display information that action queries are about to run
MsgBox "Running Action Queries, Standby...", vbInformation

' Turn on hourglass
DoCmd.Hourglass True

' Turn on status meter
SysCmd acSysCmdInitMeter, "working...", 100

' Start DoCmd for action queries
DoCmd.OpenQuery "Make_Table_Query1"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt

DoCmd.OpenQuery "Make_Table_Query2"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt

DoCmd.OpenQuery "Make_Table_Query3"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt

DoCmd.OpenQuery "Make_Table_Query4"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt

DoCmd.OpenQuery "Make_Table_Query5"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt

DoCmd.OpenQuery "Make_Table_Query6"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt

DoCmd.OpenQuery "Make_Table_Query7"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt

DoCmd.OpenQuery "Make_Table_Query8"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt  

DoCmd.OpenQuery "Make_Table_Query9"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt

DoCmd.OpenQuery "Make_Table_Query10"
intCnt = intCnt + 10
SysCmd acSysCmdUpdateMeter, intCnt  

' Set warnings back on
DoCmd.SetWarnings True

' Remove the progress bar
SysCmd acSysCmdRemoveMeter

' Remove the status bar
DoCmd.Hourglass False

End Sub

Answer 1

只需添加 DoEvents。我循环不重复相同的命令。

Private Sub PS_Report_Date_AfterUpdate()

Dim intCnt As Integer
Dim qname As String
intCnt = 0

DoCmd.SetWarnings False

DoCmd.Close acReport, "Report Name", acSavePrompt

' Display information that action queries are about to run
MsgBox "Running Action Queries, Standby...", vbInformation

' Turn on hourglass
DoCmd.Hourglass True

' Turn on status meter
SysCmd acSysCmdInitMeter, "working...", 100

For I = 1 To 10
  qname = "Make_Table_Query" & CStr(I)
  ' Start DoCmd for action queries    
  DoCmd.OpenQuery qname
  intCnt = intCnt + 10
  SysCmd acSysCmdUpdateMeter, intCnt
  DoEvents
Next I

' Set warnings back on
DoCmd.SetWarnings True

' Remove the progress bar
SysCmd acSysCmdRemoveMeter

' Remove the status bar
DoCmd.Hourglass False

End Sub

如果不行，添加

Dim qdf AS QueryDef

到sub的up，改变loop

For I = 1 To 10
  qname = "Make_Table_Query" & CStr(I)
  Set qdf = CurrentDb.QueryDefs(qname) 
  ' execute the query    
  qdf.Execute
  intCnt = intCnt + 10
  SysCmd acSysCmdUpdateMeter, intCnt
  DoEvents
Next I

操作查询的进度条

Progress Bar for Action Queries

ms-access

vba

ms-access-2010