Progress Indicator in Access

[NeoPa]

Progress Indicator in Access


Introduction
Access has a bad habit of getting tied up with its processing and not giving a clue as to whether it has crashed or not (The operating system and tools simply indicate that the application is Not Responding, which is the same message seen when an application really has crashed). An unfortunate result of this, understandable in a way, is that many users assume that it has crashed when it hasn't. Unfortunately, their response to this is often to crash out forcibly anyway, and start again. This can be quite a problem, as other than the fact that this is one of the most reliable ways found to cause database corruptions, it can also trigger problems due to code not often being designed to be self-recovering (IE. If the code is made up of blocks A, B & C, then it is necessary for the blocks to be run singly and in sequence. If A runs, then B fails to run, thereby causing the process to start again, block A will run again. The code was never designed to support A running twice before block B runs). As an aside, Access (DAO and ADODB) does support transactional processing - (BeginTrans, CommitTrans, Rollback Methods, but many databases don't incorporate this in their designs).


Suggested Solution
Let me first introduce the concept of the Progress Indicator in the Status Bar. Application.SysCmd() provides that facility. It is not my intention to go into any further detail on that here, but the Help system describes it in full for anyone who's interested.

The alternative concept, that I do intend to discuss, uses a non-modal form. I include an image of the design here to illustrate the basic concept. This is a more complicated version than the basic requirement, but over time I've added useful complexities, and as they are already available I thought they may as well be included.

The idea is that the form is displayed at the start of the running code, with the descriptions of the main steps passed to it beforehand, and a call is made to update the display when each step is completed. When control returns to the operator at the end the form is allowed to stay visible for a pre-determined period (Two seconds is the default), but then it is closed. The operator can choose to clear it within that final delay period by clicking on the title if they wish. An image of how it looks when run live (This is after completing the whole set of tasks) is included here as an illustration.

To avoid the problem of the form disappearing when, for instance, the operator clicks somewhere else on the application, the timer routine is set to reselect the form every 1/4 of a second. This ensures there is never any reason for an operator to panic and crash the application.


Implementation

Notice that there are a number of controls appearing in a list below the top label, which says Please wait... Each row consists of two controls: one to indicate the status (Not started; Running; Completed; Hidden (not to be run on this occasion)), and the other simply to show the caption of each task. There are 25 rows in all, and each row consists of lblTicknn and lblLabelnn where nn reflects the two-digit row number starting from 00 (lblTick00, lblLabel00, lblTick01, ..., lblTick24, lblLabel24).

Any unnecessary rows are hidden from sight before the form is displayed, so it is only ever as large as it needs to be for the tasks at hand.

The code for the form itself is included here :

Option Compare Database
Option Explicit
'The frmProgress form is designed to stay visible for about 2" after it expires.
'However, the operator can cancel the delay if he clicks on the form's title.
'11/5/2006  Allows ten entries.
'15/5/2006  Resize form to handle only the number of entries required.
'           This cannot work as the form size itself never changes on screen.
'18/08/2008 Tried again using Access 2003
 
Private Const conMaxStep As Integer = 24    'Steps = conMaxSteps + 1 (From 0)
Private Const conDelSecs As Integer = 2     'Default delay in secs
Private Const conProgSep As String = "~"    'Separator character within strMsgs
Private Const conCross As Long = &HFB       'Wingdings cross
Private Const conTick As Long = &HFC        'Wingdings tick
Private Const conCM As Long = &H238         'Centimeter
 
'intPeriod 1/4"s counted after completion; intDelay 1/4"s to count;
'intLastStep is the last step used on the form
Private intPeriod As Integer, intDelay As Integer, intLastStep As Integer
Private lblTicks(0 To conMaxStep) As Label, lblSteps(0 To conMaxStep) As Label
 
Private Sub Form_Open(Cancel As Integer)
    Dim strStep As String
    Dim ctlThis As Control
 
    'Assign all labels to the arrays.  Ignore any failures.
    On Error Resume Next
    For Each ctlThis In Controls
        strStep = Right(ctlThis.Name, 2)
        Select Case Left(ctlThis.Name, 7)
        Case "lblTick"
            Set lblTicks(CInt(strStep)) = ctlThis
        Case "lblStep"
            Set lblSteps(CInt(strStep)) = ctlThis
        End Select
    Next ctlThis
    On Error GoTo 0
End Sub
 
'intStep = 0            Reset all and set up captions
'intStep = Positive     Operate on relevant (intStep-1) line of the display
'intStep = Negative     Close Progress form after processing -intStep
 
'  intState = 0         Not started yet - visible / dim
'  intState = 1         In progress     - visible / bold
'  intState = 2         Completed       - visible / ticked
'  intState = 3         Hidden          - visible / dim / crossed
'  intState = 4         In progress for intStep - Completed for previous step
'  intState = 5         In progress for intStep - Hidden for previous step
Public Sub SetStep(ByVal intStep As Integer, _
                   Optional ByVal intState As Integer = -1, _
                   Optional ByRef strMsgs As String = "", _
                   Optional ByVal intDelSecs As Integer = -1, _
                   Optional ByVal dblCM As Double = 0)
    Dim intIdx As Integer, intTop As Integer
    Dim lngSize As Long
    Dim blnClose As Boolean
 
    'Cancel any pending close (see Timer code)
    intPeriod = 0
    'Default intDelSecs if not set
    If intDelSecs = -1 Then intDelSecs = conDelSecs
    'Default intState depending on intStep
    If intState = -1 Then
        Select Case intStep
        Case 0              'Open - Default = 1 In progress
            intState = 1
        Case Is > 0         'Change step - Default = 4 Complete & In progress
            intState = 4
        Case Is < 0         'Close - Default = 2 Complete
            intState = 2
        End Select
    End If
    Select Case Abs(intStep)
    Case 0      'Reset all and set up captions
        intDelay = intDelSecs * 4 + Sgn(intDelSecs)
        'find number of elements in strMsgs
        intTop = UBound(Split(strMsgs, conProgSep))
        If intTop > conMaxStep Then intTop = conMaxStep
        For intIdx = 0 To conMaxStep
            If intIdx > intTop Then
                lblTicks(intIdx).Visible = False
                lblSteps(intIdx).Visible = False
            Else
                lblSteps(intIdx).Visible = True
                lblSteps(intIdx).Caption = Split(strMsgs, conProgSep)(intIdx)
                Call SetState(intStep:=intIdx, _
                              intState:=IIf(intIdx = 0, intState, 0))
            End If
        Next intIdx
        'Resize form depending on # of lines used and lngWidth passed
        With Me
            If intTop < conMaxStep Then
                lngSize = (conMaxStep - intTop) * conCM / 2
                .boxInner.Height = .boxInner.Height - lngSize
                .boxOuter.Height = .boxOuter.Height - lngSize
                .InsideHeight = .InsideHeight - lngSize
                'Following line depends on Access 2003
                Call .Move(Left:=.WindowLeft, Top:=.WindowTop + lngSize / 2)
            End If
            If dblCM > 0 Then
                lngSize = dblCM * conCM
                .lblTitle.Width = .lblTitle.Width - lngSize
                .boxInner.Width = .boxInner.Width - lngSize
                .boxOuter.Width = .boxOuter.Width - lngSize
                .InsideWidth = .InsideWidth - lngSize
                For intTop = intTop To 0 Step -1
                    lblSteps(intTop).Width = lblSteps(intTop).Width - lngSize
                Next intTop
                'Following line depends on Access 2003
                Call .Move(Left:=.WindowLeft + lngSize / 2)
            End If
        End With
    Case 1 To conMaxStep + 1
        Call SetState(Abs(intStep) - 1, intState)
    End Select
    If intStep < 0 Then     'Close Progress form
        If intDelay = 0 Then Call CloseMe
        'Otherwise start timer
        intPeriod = 1
    End If
    'Update the screen
    DoEvents
End Sub
 
Private Sub SetState(intStep As Integer, intState As Integer)
    lblTicks(intStep).Caption = Chr(conTick)
    lblSteps(intStep).FontBold = False
    Select Case intState
    Case 0          'Not started yet (dim)
        lblTicks(intStep).Visible = False
        lblSteps(intStep).ForeColor = vbBlue
    Case 1, 4, 5    'In progress (bold)
        lblTicks(intStep).Visible = False
        lblSteps(intStep).ForeColor = vbRed
        lblSteps(intStep).FontBold = True
        If intState > 3 And intStep > 0 Then _
            Call SetState(intStep:=intStep - 1, intState:=intState - 2)
    Case 2      'Completed (Tick)
        lblTicks(intStep).Visible = True
        lblSteps(intStep).ForeColor = vbRed
    Case 3      'Hidden (dim / cross)
        lblTicks(intStep).Caption = Chr(conCross)
        lblTicks(intStep).Visible = True
        lblSteps(intStep).ForeColor = vbBlue
    End Select
    'Always bring frmProgress to front when updating
    Call DoCmd.SelectObject(ObjectType:=acForm, ObjectName:=Me.Name)
    'Update the screen
    DoEvents
End Sub
 
Private Sub lblTitle_Click()
    If intPeriod > 0 Then Call CloseMe
End Sub
 
Private Sub Form_Timer()
    Select Case intPeriod
    Case 0
        Exit Sub
    Case Is < intDelay
        intPeriod = intPeriod + 1
        Call DoCmd.SelectObject(ObjectType:=acForm, ObjectName:=Me.Name)
    Case Else
        Call CloseMe
    End Select
End Sub
 
Private Sub CloseMe()
    Call DoCmd.Close(ObjectType:=acForm, ObjectName:=Me.Name)
End Sub

Instructions for Use
The code to use this is fairly straightforward at its most basic, but does provide flexibility for quite involved processes containing many tasks.


Example Code
Here is the code used in the attached example database :

Option Compare Database
Option Explicit
 
Private frmProg As Form_frmProgress
 
Private Sub Form_Open(Cancel As Integer)
    Call DoCmd.Restore
    If DBWindowVisible() Then
        Call DoCmd.SelectObject(ObjectType:=acForm, InDatabaseWindow:=True)
        Call DoCmd.RunCommand(Command:=acCmdWindowHide)
    End If
End Sub
 
Private Sub cmdTest_Click()
    Dim strMsgs As String
    Dim datStart As Date
 
    strMsgs = "Task taking 5 seconds~" & _
              "This task takes just 1 second~" & _
              "This task is skipped~" & _
              "This task takes 20 seconds"
    Set frmProg = New Form_frmProgress
    Call frmProg.SetStep(intStep:=0, strMsgs:=strMsgs)
    datStart = Now()
    Do
        DoEvents
    Loop While Now() < (datStart + (5 / 86400))
    Call frmProg.SetStep(intStep:=2)
    datStart = Now()
    Do
        DoEvents
    Loop While Now() < (datStart + (1 / 86400))
    Call frmProg.SetStep(intStep:=3, intState:=4)
    Call frmProg.SetStep(intStep:=4, intState:=5)
    datStart = Now()
    Do
        DoEvents
    Loop While Now() < (datStart + (20 / 86400))
    Call frmProg.SetStep(intStep:=-4)
End Sub
 
Private Sub cmdExit_Click()
    Call DoCmd.Close
End Sub
 
Private Sub Form_Close()
    'Method must exist in order for container to handle event.
    If Not DBWindowVisible() Then _
        Call DoCmd.SelectObject(ObjectType:=acForm, InDatabaseWindow:=True)
End Sub

This is mostly dummy code, but the important lines are :

1. #18 through #21 - Sets the captions for each of the four tasks.
2. #22 creates the instance of the frmProgress form.
3. #23 sets it up and passes the captions (in strMsgs) it needs to deal with.
4. #28, #33, #34 & #39 deal with updating the status for the various lines.
5. #39 particularly, as the negative number indicates that frmProgress should start the timer for closing itself down.

There are more options to explore in the code, but this covers the basics.

[ADezii]

@NeoPa - First of all, let me compliment you on you excellent Progress Indicator in Access. I find it to be a very useful and flexible Tool that I will use in my Apps that will deploy multiple Processes. I also thank you for sharing this with us here at Bytes. I must be a little dense lately, because there are just a couple of points that I cannot fathom at this time. If you could answer these questions, I would be very grateful. Thanks in advance.

1. The actual Value passed to the SetStep() Sub-Routine does not appear to matter, only if this Value is =0, < 0, or > 0. Is this correct?
2. What is the difference between the State Values of 1, 4, and 5?
3. What exactly does a State Value of 3 designate?

P.S. - Again, I hope this period of not being able to comprehend is brief! (LOL). As always, a pleasure.

[NeoPa]

ADezii, if you don't see something, there's a good chance that it means many (most) others won't either. I'm therefore more than happy to clarify any points you bring up, on the understanding that they are likely to benefit many more people than just you.

1. The actual Value passed to the SetStep() Sub-Routine does not appear to matter, only if this Value is =0, < 0, or > 0. Is this correct?
   No. Absolutely not correct.
   
   While the Select Case Abs(intStep) statement of line #74 controls whether the code should set the form up (if it's zero) or manage an update in the form (if it's non-zero), the code at line #115 (Call SetState(Abs(intStep) - 1, intState)) calls a procedure, passing the the value of Abs(intStep) - 1. This value determines which of the possible messages gets their status updated. Without a specific caption number passed this would be impossible to determine, so that value is definitely required and crucial to the working of the form.
2. What is the difference between the State Values of 1, 4, and 5?
   State #4 & #5 are shortcuts. Essentially, the calls to say "Set step #2 to completed, then set step #3 to In progress" can be handled by the single call using intStep:=3 and intState:=4. In code that would be :
   

   Call Call frmProg.SetStep(intStep:=3, intState:=4)

   instead of using the longer form of :
   

   Call Call frmProg.SetStep(intStep:=2, intState:=2)
   Call Call frmProg.SetStep(intStep:=3, intState:=1)

   The code using intState:=5, equally, could replace two lines for intState values of 3 & 1.
3. What exactly does a State Value of 3 designate?
   This is used within a process which includes steps which are conditional on other factors. An example might be a step to delete a table which comes before a step to create that table again. If a prior step indicates that table doesn't already exist, the code would not execute the step to delete the table. On the form this would be indicated by that step being set to Hidden (State #3).

I hope this helps to clarify things.

[ADezii]

Thanks for taking up the time to clear up a fogged mind.

[NeoPa]

Always a pleasure, and it doesn't just help you that I make the points easier to follow ;-)

[Nauticalgent]

NeoPa,

I will be implementing this code ASAP, thanks for sharing. I will post in a new thread as to why I THINK I shouldn't need it and hopefully we can resolve that issue.

Thanks again.

[NeoPa]

I'll keep a lookout for it :-)