如何使用多个查询在Access 2010中创建进度条

时间:2016-03-11 16:41:02

标签: ms-access-2010

我想在表单中添加一个进度条,考虑到我正在运行多个查询,比如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     

1 个答案:

答案 0 :(得分:1)

为了正确地执行此操作(即在执行QueryDef之后不执行进度条指令),我们应该能够遍历所有查询。因此,最简单的方法是将所有SQL指令放在arraycollection中,我选择了后者。

表单设计

添加到您的表单1个矩形,它将成为您的进度条背景,为其指定背景颜色并将其命名为 ProgressBarA

复制/粘贴 ProgressBarA ,将此新矩形命名为 ProgressBarB ,并将其放在 ProgressBarA 上,然后再将其添加到背景颜色并制作它#39 ; s宽度稍短,所以你可以看到两个矩形,这更容易。这将是"填满"

的标准

表格代码

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

未经测试,但您有这个想法。如果它不能马上工作,它应该经过一些小的调整