如何使用多个查询在 access 2010 中创建进度条
How to create a Progress Bar in access 2010 with multiples queries
考虑到我是 运行 多个查询，比如 30 个查询，我想在表单中添加一个进度条，并且我希望进度条随着查询的执行而增长。
这是我的代码：
Private Sub Command5_Click()
Dim X As Integer
X = MsgBox("Are you Sure you want to Send to Server?????", vbOKCancel, "Are you sure?")
If X = vbOK Then
' If PASSWORD = "222222" Then
Dim intX, intY As Integer
DoCmd.SetWarnings False
Me.Refresh
' DoCmd.Close acForm, "enterpassword"
With CurrentDb
intX = DCount("*", "RECORDS IN JobsOrder NOT IN JobsOrder1")
MsgBox (intX & " RECORDS WILL BE ADDED")
Call .QueryDefs("UPDATE_Jobsorder1_SERVER_WITH_Jobsorder").Execute
Call .QueryDefs("UPDATE_Jobsorder2_SERVER_WITH_Jobsorder").Execute
Call .QueryDefs("UPDATE_General1_SERVER_WITH_General").Execute
Call .QueryDefs("UPDATE_General2_SERVER_WITH_General").Execute
Call .QueryDefs("UPDATE_Hydrant1_SERVER_WITH_Hydrant").Execute
Call .QueryDefs("UPDATE_Hydrant2_SERVER_WITH_Hydrant").Execute
Call .QueryDefs("UPDATE_Inspect1_SERVER_WITH_Inspect").Execute
Call .QueryDefs("UPDATE_Inspect2_SERVER_WITH_Inspect").Execute
Call .QueryDefs("UPDATE_Mains1_SERVER_WITH_Mains").Execute
Call .QueryDefs("UPDATE_Mains2_SERVER_WITH_Mains").Execute
Call .QueryDefs("UPDATE_Services1_SERVER_WITH_Services").Execute
Call .QueryDefs("UPDATE_Services2_SERVER_WITH_Services").Execute
Call .QueryDefs("UPDATE_Valves1_SERVER_WITH_Valves").Execute
Call .QueryDefs("UPDATE_Valves2_SERVER_WITH_Valves").Execute
Call .QueryDefs("UPDATE_WortendykeJobs1_SERVER_WITH_WortendykeJobs").Execute
Call .QueryDefs("UPDATE_WortendykeJobs2_SERVER_WITH_WortendykeJobs").Execute
Call .QueryDefs("Append RECORDS IN General NOT IN General1 to General1").Execute
Call .QueryDefs("Append RECORDS IN General NOT IN General2 to General2").Execute
Call .QueryDefs("Append RECORDS IN Hydrant NOT IN Hydrant1 to Hydrant1").Execute
Call .QueryDefs("Append RECORDS IN Hydrant NOT IN Hydrant2 to Hydrant2").Execute
Call .QueryDefs("Append RECORDS IN Inspect NOT IN Inspect1 to Inspect1").Execute
Call .QueryDefs("Append RECORDS IN Inspect NOT IN Inspect2 to Inspect2").Execute
Call .QueryDefs("APPEND RECORDS IN jobsOrder NOT IN Jobsorder1 to JobsOrder1").Execute
Call .QueryDefs("APPEND RECORDS IN jobsOrder NOT IN Jobsorder2 to JobsOrder2").Execute
Call .QueryDefs("APPEND RECORDS IN Mains NOT IN Mains1 to Mains1").Execute
Call .QueryDefs("APPEND RECORDS IN Mains NOT IN Mains2 to Mains2").Execute
Call .QueryDefs("APPEND RECORDS IN Services NOT IN Services1 to Services1").Execute
Call .QueryDefs("APPEND RECORDS IN Services NOT IN Services2 to Services2").Execute
Call .QueryDefs("APPEND RECORDS IN Valves NOT IN Valves1 to Valves1").Execute
Call .QueryDefs("APPEND RECORDS IN Valves NOT IN Valves2 to Valves2").Execute
Call .QueryDefs("APPEND RECORDS IN Wort NOT IN WortendykeJobs1 to WortendykeJobs1").Execute
Call .QueryDefs("APPEND RECORDS IN Wort NOT IN WortendykeJobs2 to WortendykeJobs2").Execute
'Call .QueryDefs("DELETE_Records_JobsOrder").Execute
Call Me.Requery
DoCmd.SetWarnings True
End With
MsgBox ("TRANSFER AND UPDATE HAS BEEN FINISHED!!!")
' Else
' MsgBox ("password Invalid!!!")
' End If
Exit Sub
ElseIf X = vbCancel Then
Exit Sub
End If
End Sub
为了正确执行此操作（即在您的每个 QueryDef 执行后不执行进度条指令），我们应该能够遍历您的所有查询。所以最简单的方法是将所有 SQL 指令放在 array 或 collection 中，我选择了后者。
表单设计
添加到您的表单 1 矩形，这将是您的进度条背景，给它一个背景色并将其命名为 ProgressBarA
Copy/Paste ProgressBarA，将这个新矩形命名为 ProgressBarB 并将其放在 ProgressBarA[= 的正上方30=]，给它另一种背景颜色，让它的宽度短一点，这样你就可以看到两个矩形，这样更容易。这将是 "fill up"
的酒吧
表单代码
Private colSQL As Collection
Private Sub Define_SQL_Queries()
Set colSQL = New Collection
colSQL.Add "UPDATE_Jobsorder2_SERVER_WITH_Jobsorder"
colSQL.Add "UPDATE_General1_SERVER_WITH_General"
colSQL.Add "UPDATE_General2_SERVER_WITH_General"
colSQL.Add "UPDATE_Hydrant1_SERVER_WITH_Hydrant"
colSQL.Add "UPDATE_Hydrant2_SERVER_WITH_Hydrant"
colSQL.Add "UPDATE_Inspect1_SERVER_WITH_Inspect"
colSQL.Add "UPDATE_Inspect2_SERVER_WITH_Inspect"
colSQL.Add "UPDATE_Mains1_SERVER_WITH_Mains"
colSQL.Add "UPDATE_Mains2_SERVER_WITH_Mains"
colSQL.Add "UPDATE_Services1_SERVER_WITH_Services"
colSQL.Add "UPDATE_Services2_SERVER_WITH_Services"
colSQL.Add "UPDATE_Valves1_SERVER_WITH_Valves"
colSQL.Add "UPDATE_Valves2_SERVER_WITH_Valves"
colSQL.Add "UPDATE_WortendykeJobs1_SERVER_WITH_WortendykeJobs"
colSQL.Add "UPDATE_WortendykeJobs2_SERVER_WITH_WortendykeJobs"
colSQL.Add "Append RECORDS IN General NOT IN General1 to General1"
colSQL.Add "Append RECORDS IN General NOT IN General2 to General2"
colSQL.Add "Append RECORDS IN Hydrant NOT IN Hydrant1 to Hydrant1"
colSQL.Add "Append RECORDS IN Hydrant NOT IN Hydrant2 to Hydrant2"
colSQL.Add "Append RECORDS IN Inspect NOT IN Inspect1 to Inspect1"
colSQL.Add "Append RECORDS IN Inspect NOT IN Inspect2 to Inspect2"
colSQL.Add "APPEND RECORDS IN jobsOrder NOT IN Jobsorder1 to JobsOrder1"
colSQL.Add "APPEND RECORDS IN jobsOrder NOT IN Jobsorder2 to JobsOrder2"
colSQL.Add "APPEND RECORDS IN Mains NOT IN Mains1 to Mains1"
colSQL.Add "APPEND RECORDS IN Mains NOT IN Mains2 to Mains2"
colSQL.Add "APPEND RECORDS IN Services NOT IN Services1 to Services1"
colSQL.Add "APPEND RECORDS IN Services NOT IN Services2 to Services2"
colSQL.Add "APPEND RECORDS IN Valves NOT IN Valves1 to Valves1"
colSQL.Add "APPEND RECORDS IN Valves NOT IN Valves2 to Valves2"
colSQL.Add "APPEND RECORDS IN Wort NOT IN WortendykeJobs1 to WortendykeJobs1"
colSQL.Add "APPEND RECORDS IN Wort NOT IN WortendykeJobs2 to WortendykeJobs2"
End Sub
Private Sub Command5_Click()
Dim X As Integer
Dim i As Integer
Dim strSQL As String
X = MsgBox("Are you Sure you want to Send to Server?????", vbOKCancel, "Are you sure?")
If X = vbOK Then
' If PASSWORD = "222222" Then
Dim intX, intY As Integer
' REINIT PROGRESS BAR
ProgressBarB.Width = 0
Me.Repaint
' FILL IN OUR SQL QUERIES COLLECTION
Define_SQL_Queries
DoCmd.SetWarnings False
Me.Refresh
' DoCmd.Close acForm, "enterpassword"
With CurrentDb
intX = DCount("*", "RECORDS IN JobsOrder NOT IN JobsOrder1")
MsgBox (intX & " RECORDS WILL BE ADDED")
For i = 1 To colSQL.Count
strSQL = colSQL(i)
Debug.Print "Executing : " & strSQL
Call .QueryDefs(strSQL).Execute
ProgressBarB.Width = (ProgressBarA.Width / colSQL.Count) * i
Me.Repaint
Next i
Call Me.Requery
DoCmd.SetWarnings True
End With
MsgBox ("TRANSFER AND UPDATE HAS BEEN FINISHED!!!")
' Else
' MsgBox ("password Invalid!!!")
' End If
Exit Sub
ElseIf X = vbCancel Then
Exit Sub
End If
End Sub
未经测试，但您有想法。如果它不能立即工作，应该经过一些小的调整
考虑到我是 运行 多个查询，比如 30 个查询，我想在表单中添加一个进度条，并且我希望进度条随着查询的执行而增长。 这是我的代码：
Private Sub Command5_Click()
Dim X As Integer
X = MsgBox("Are you Sure you want to Send to Server?????", vbOKCancel, "Are you sure?")
If X = vbOK Then
' If PASSWORD = "222222" Then
Dim intX, intY As Integer
DoCmd.SetWarnings False
Me.Refresh
' DoCmd.Close acForm, "enterpassword"
With CurrentDb
intX = DCount("*", "RECORDS IN JobsOrder NOT IN JobsOrder1")
MsgBox (intX & " RECORDS WILL BE ADDED")
Call .QueryDefs("UPDATE_Jobsorder1_SERVER_WITH_Jobsorder").Execute
Call .QueryDefs("UPDATE_Jobsorder2_SERVER_WITH_Jobsorder").Execute
Call .QueryDefs("UPDATE_General1_SERVER_WITH_General").Execute
Call .QueryDefs("UPDATE_General2_SERVER_WITH_General").Execute
Call .QueryDefs("UPDATE_Hydrant1_SERVER_WITH_Hydrant").Execute
Call .QueryDefs("UPDATE_Hydrant2_SERVER_WITH_Hydrant").Execute
Call .QueryDefs("UPDATE_Inspect1_SERVER_WITH_Inspect").Execute
Call .QueryDefs("UPDATE_Inspect2_SERVER_WITH_Inspect").Execute
Call .QueryDefs("UPDATE_Mains1_SERVER_WITH_Mains").Execute
Call .QueryDefs("UPDATE_Mains2_SERVER_WITH_Mains").Execute
Call .QueryDefs("UPDATE_Services1_SERVER_WITH_Services").Execute
Call .QueryDefs("UPDATE_Services2_SERVER_WITH_Services").Execute
Call .QueryDefs("UPDATE_Valves1_SERVER_WITH_Valves").Execute
Call .QueryDefs("UPDATE_Valves2_SERVER_WITH_Valves").Execute
Call .QueryDefs("UPDATE_WortendykeJobs1_SERVER_WITH_WortendykeJobs").Execute
Call .QueryDefs("UPDATE_WortendykeJobs2_SERVER_WITH_WortendykeJobs").Execute
Call .QueryDefs("Append RECORDS IN General NOT IN General1 to General1").Execute
Call .QueryDefs("Append RECORDS IN General NOT IN General2 to General2").Execute
Call .QueryDefs("Append RECORDS IN Hydrant NOT IN Hydrant1 to Hydrant1").Execute
Call .QueryDefs("Append RECORDS IN Hydrant NOT IN Hydrant2 to Hydrant2").Execute
Call .QueryDefs("Append RECORDS IN Inspect NOT IN Inspect1 to Inspect1").Execute
Call .QueryDefs("Append RECORDS IN Inspect NOT IN Inspect2 to Inspect2").Execute
Call .QueryDefs("APPEND RECORDS IN jobsOrder NOT IN Jobsorder1 to JobsOrder1").Execute
Call .QueryDefs("APPEND RECORDS IN jobsOrder NOT IN Jobsorder2 to JobsOrder2").Execute
Call .QueryDefs("APPEND RECORDS IN Mains NOT IN Mains1 to Mains1").Execute
Call .QueryDefs("APPEND RECORDS IN Mains NOT IN Mains2 to Mains2").Execute
Call .QueryDefs("APPEND RECORDS IN Services NOT IN Services1 to Services1").Execute
Call .QueryDefs("APPEND RECORDS IN Services NOT IN Services2 to Services2").Execute
Call .QueryDefs("APPEND RECORDS IN Valves NOT IN Valves1 to Valves1").Execute
Call .QueryDefs("APPEND RECORDS IN Valves NOT IN Valves2 to Valves2").Execute
Call .QueryDefs("APPEND RECORDS IN Wort NOT IN WortendykeJobs1 to WortendykeJobs1").Execute
Call .QueryDefs("APPEND RECORDS IN Wort NOT IN WortendykeJobs2 to WortendykeJobs2").Execute
'Call .QueryDefs("DELETE_Records_JobsOrder").Execute
Call Me.Requery
DoCmd.SetWarnings True
End With
MsgBox ("TRANSFER AND UPDATE HAS BEEN FINISHED!!!")
' Else
' MsgBox ("password Invalid!!!")
' End If
Exit Sub
ElseIf X = vbCancel Then
Exit Sub
End If
End Sub
为了正确执行此操作（即在您的每个 QueryDef 执行后不执行进度条指令），我们应该能够遍历您的所有查询。所以最简单的方法是将所有 SQL 指令放在 array 或 collection 中，我选择了后者。
表单设计
添加到您的表单 1 矩形，这将是您的进度条背景，给它一个背景色并将其命名为 ProgressBarA
Copy/Paste ProgressBarA，将这个新矩形命名为 ProgressBarB 并将其放在 ProgressBarA[= 的正上方30=]，给它另一种背景颜色，让它的宽度短一点，这样你就可以看到两个矩形，这样更容易。这将是 "fill up"
的酒吧表单代码
Private colSQL As Collection
Private Sub Define_SQL_Queries()
Set colSQL = New Collection
colSQL.Add "UPDATE_Jobsorder2_SERVER_WITH_Jobsorder"
colSQL.Add "UPDATE_General1_SERVER_WITH_General"
colSQL.Add "UPDATE_General2_SERVER_WITH_General"
colSQL.Add "UPDATE_Hydrant1_SERVER_WITH_Hydrant"
colSQL.Add "UPDATE_Hydrant2_SERVER_WITH_Hydrant"
colSQL.Add "UPDATE_Inspect1_SERVER_WITH_Inspect"
colSQL.Add "UPDATE_Inspect2_SERVER_WITH_Inspect"
colSQL.Add "UPDATE_Mains1_SERVER_WITH_Mains"
colSQL.Add "UPDATE_Mains2_SERVER_WITH_Mains"
colSQL.Add "UPDATE_Services1_SERVER_WITH_Services"
colSQL.Add "UPDATE_Services2_SERVER_WITH_Services"
colSQL.Add "UPDATE_Valves1_SERVER_WITH_Valves"
colSQL.Add "UPDATE_Valves2_SERVER_WITH_Valves"
colSQL.Add "UPDATE_WortendykeJobs1_SERVER_WITH_WortendykeJobs"
colSQL.Add "UPDATE_WortendykeJobs2_SERVER_WITH_WortendykeJobs"
colSQL.Add "Append RECORDS IN General NOT IN General1 to General1"
colSQL.Add "Append RECORDS IN General NOT IN General2 to General2"
colSQL.Add "Append RECORDS IN Hydrant NOT IN Hydrant1 to Hydrant1"
colSQL.Add "Append RECORDS IN Hydrant NOT IN Hydrant2 to Hydrant2"
colSQL.Add "Append RECORDS IN Inspect NOT IN Inspect1 to Inspect1"
colSQL.Add "Append RECORDS IN Inspect NOT IN Inspect2 to Inspect2"
colSQL.Add "APPEND RECORDS IN jobsOrder NOT IN Jobsorder1 to JobsOrder1"
colSQL.Add "APPEND RECORDS IN jobsOrder NOT IN Jobsorder2 to JobsOrder2"
colSQL.Add "APPEND RECORDS IN Mains NOT IN Mains1 to Mains1"
colSQL.Add "APPEND RECORDS IN Mains NOT IN Mains2 to Mains2"
colSQL.Add "APPEND RECORDS IN Services NOT IN Services1 to Services1"
colSQL.Add "APPEND RECORDS IN Services NOT IN Services2 to Services2"
colSQL.Add "APPEND RECORDS IN Valves NOT IN Valves1 to Valves1"
colSQL.Add "APPEND RECORDS IN Valves NOT IN Valves2 to Valves2"
colSQL.Add "APPEND RECORDS IN Wort NOT IN WortendykeJobs1 to WortendykeJobs1"
colSQL.Add "APPEND RECORDS IN Wort NOT IN WortendykeJobs2 to WortendykeJobs2"
End Sub
Private Sub Command5_Click()
Dim X As Integer
Dim i As Integer
Dim strSQL As String
X = MsgBox("Are you Sure you want to Send to Server?????", vbOKCancel, "Are you sure?")
If X = vbOK Then
' If PASSWORD = "222222" Then
Dim intX, intY As Integer
' REINIT PROGRESS BAR
ProgressBarB.Width = 0
Me.Repaint
' FILL IN OUR SQL QUERIES COLLECTION
Define_SQL_Queries
DoCmd.SetWarnings False
Me.Refresh
' DoCmd.Close acForm, "enterpassword"
With CurrentDb
intX = DCount("*", "RECORDS IN JobsOrder NOT IN JobsOrder1")
MsgBox (intX & " RECORDS WILL BE ADDED")
For i = 1 To colSQL.Count
strSQL = colSQL(i)
Debug.Print "Executing : " & strSQL
Call .QueryDefs(strSQL).Execute
ProgressBarB.Width = (ProgressBarA.Width / colSQL.Count) * i
Me.Repaint
Next i
Call Me.Requery
DoCmd.SetWarnings True
End With
MsgBox ("TRANSFER AND UPDATE HAS BEEN FINISHED!!!")
' Else
' MsgBox ("password Invalid!!!")
' End If
Exit Sub
ElseIf X = vbCancel Then
Exit Sub
End If
End Sub
未经测试，但您有想法。如果它不能立即工作，应该经过一些小的调整