Progress Meter in 8 steps

‘————————————————-
‘ Stage 1: Initialization
‘————————————————-
Dim TotalRec As Long                        ‘ Total number of records
Dim fOK As Boolean                          ‘ Continue/Cancel process
TotalRec = 0                                ‘ Total number of records
Dim StatusMeter As clsStatusMeter
Set StatusMeter = New clsStatusMeter
                                            ‘ Init Progress Meter, Welcome message
Call StatusMeter.Init(Msg("Updating dictionary") & " …", True, 500)

‘————————————————-

DoCmd.Hourglass True

‘————————————————-
‘ Stage 2: Get Total Records, Display number of records to process 
‘————————————————-

‘ Define total records

TotalRec = rst.RecordCount

Call StatusMeter.TotalRecords(TotalRec)

If rst.RecordCount > 0 Then

 

‘——————–
‘ Loop start

‘——————–
Do While Not rstSourceSites.EOF
    ‘————————————————-
    ‘ Stage 3′: Update Header Meter and Check for Cancel
    ‘————————————————-
    fOK = StatusMeter.UpdateHeaderCancel(0)
    If Not fOK Then

        DoCmd.Hourglass False
        ‘ Update status info
        Call StatusMeter.AddInfo("Userabort", Msg("Operation cancelled by") & " " & GetUserName() & ".")

        Call LogMsgBox(Msg("Operation cancelled") & "!", _
            vbOKOnly + vbInformation, Msg("Copying tariffs"), _
            Form.Name, "cmdOk", Not CBool(curUser.DBReadSettings("StatusMeterDetails")))
        GoTo WrapUp
    End If

‘————————————————-
‘ Stage 4′: Display process info
‘————————————————-
Call StatusMeter.AddInfo("Present", DBLookUp("TransportationServiceName", "Transportation services", "TransportationServiceID=" & rstSourceSites![TransportationServiceID]))

 

NextRecord:
            ‘————————————————-
            ‘ Stage 5: Increment ProgressCounter, Next Record 
            ‘————————————————-
            Call StatusMeter.UpdateMeter(1)

            rstSourceSites.MoveNext
        Loop

‘——————–
‘ Loop end

‘——————–

End If

 

‘————————————————-

‘ Stage 6: Display Overall Statistics, Optional

‘————————————————-

Call StatusMeter.AddInfo("Smileregular", Msg("Successfully moved") & ": " & MovedRecords)
‘Call StatusMeter.AddInfo("Smileembaressed", Msg("Total recommendations") & ": " & WarningsCustomers)
Call StatusMeter.AddInfo("Smileangry", Msg("Total errors") & ": " & TotalErrorsRegNumber + TotalErrorsCustomers + TotalErrorsLoadName)

‘————————————————-
‘ Stage 7: End of operation
‘————————————————-
If fOK And StatusMeter.AutoHide Then
    ‘ End of operation
     Call StatusMeter.CloseMeter

ElseIf fOK And Not StatusMeter.AutoHide Then
    ‘ End of operation with detailed view
    Call StatusMeter.AddInfo("System", Msg("Time") & ":" & StatusMeter.StrTime(True) & ". ")
    Call StatusMeter.AddInfo("Success", Msg("End of operation."))
    Call StatusMeter.UpdateMeter(TotalRec)
ElseIf Not fOK And Not CBool(curUser.DBReadSettings("StatusMeterDetails")) Then
    ‘ Operation cancelled by user, no detailed view
    Call StatusMeter.CloseMeter
ElseIf Not fOK And CBool(curUser.DBReadSettings("StatusMeterDetails")) Then
    ‘ End of operation, detail view
    ‘ Operation cancelled by user, detail view
    Call StatusMeter.AddInfo("System", Msg("Time") & ":" & StatusMeter.StrTime(True) & ". ")
    Call StatusMeter.AddInfo("Success", Msg("End of operation."))
    Call StatusMeter.UpdateMeter(TotalRec)
End If

cmdOK_Click_Exit:
    Set rst = Nothing           ‘ Deassign ADO objects
    Set conConnection = Nothing
   

‘————————————————-
‘ Stage 8: Deassign
‘————————————————-
Set StatusMeter = Nothing

    DoCmd.Hourglass False
    Exit Sub
cmdOK_Click_Err:
    LogMsgError Err.Description, Err.Number, ModuleName$, "cmdOK_Click"
    Resume cmdOK_Click_Exit