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.
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.
[imgnothumb]http://bytes.com/attachments/attachment/4703d1296871124/frmprogress.jpg[/imgnothumb]
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.
[imgnothumb]http://bytes.com/attachments/attachment/4813d1298381793/frmprogresslive .jpg[/imgnothumb]
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 :
	
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 :
	This is mostly dummy code, but the important lines are :
There are more options to explore in the code, but this covers the basics.
					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.Sys  Cmd() 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.
[imgnothumb]http://bytes.com/attachments/attachment/4703d1296871124/frmprogress.jpg[/imgnothumb]
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.
[imgnothumb]http://bytes.com/attachments/attachment/4813d1298381793/frmprogresslive .jpg[/imgnothumb]
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 :
Code:
	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 :
Code:
	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
- #18 through #21 - Sets the captions for each of the four tasks.
 - #22 creates the instance of the frmProgress form.
 - #23 sets it up and passes the captions (in strMsgs) it needs to deal with.
 - #28, #33, #34 & #39 deal with updating the status for the various lines.
 - #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.
Comment