VBA functions for easier use of simple Progress Bar and Status Bar

[Stormin]

Hi all,

I recently wanted to implement use of the status bar and/or progress bar (bottom left and bottom right in Access window respectively) in some VBA code to give the end user some info about what is happening behind the hourglass. I found how to do it online somewhere (sorry can't remember the source ) and wrote the following functions to make using them easier.

I thought I'd share to add it to the collective knowledge pool.

Status Bar:

Public Function SBar(Optional TextToDisplay As String)
    
'Updates the status bar depending on the input:
'   1. Text     Updates StatusBar text
'   2. <Empty>  Removes StatusBar
'
'Note that StatusBar will be overwritten if ProgressBar is set or cleared

    On Error Resume Next
    If Not IsMissing(TextToDisplay) Then
        If TextToDisplay <> "" Then
            SysCmd acSysCmdSetStatus, TextToDisplay
        Else
            SysCmd acSysCmdClearStatus
        End If
    Else
        SysCmd acSysCmdClearStatus
    End If

End Function

So to use the statusbar all you have to do is write something like:

    SBar "Checking datasource 1..." 'displays your text
    'Some code that checks datasource 1
    SBar "Checking datasource 2..." 'updates with new text
    'Some more code that checks datasource 2
    SBar 'clears statusbar and resets to default application messages
    'continue...

Progress Bar:

Public Function PBar(Optional TextOrPercent As Variant)
    
'Updates the progress bar depending on the input:
'   1. Text     Updates ProgressBar title
'   2. Number   Updates ProgressBar value
'   3. <Empty>  Removes ProgressBar
'
'ProgressBar is set to a value out of 100 (i.e. a percentage)
'
'Note that ProgressBar will be overwritten if StatusBar is set or cleared
    
    On Error Resume Next
    If VarType(TextOrPercent) = vbString Then
        SysCmd acSysCmdInitMeter, TextOrPercent, 100
    ElseIf IsNumeric(TextOrPercent) Then
        SysCmd acSysCmdUpdateMeter, TextOrPercent
    Else
        SysCmd acSysCmdRemoveMeter
        SysCmd acSysCmdClearStatus 'just in case
    End If
    
End Function

So to use the progessbar all you have to do is write something like:

    PBar "Checking datasource 1..." 'displays your text with progress bar at 0%
    'Some code that checks datasource 1a
    PBar 33
    'Some code that checks datasource 1b
    PBar 66
    'Some code that checks datasource 1c
    PBar 100
    PBar "Moving to next datasource..." 'updates text but keeps progressbar value
    'Some code that unloads ds1 and loads ds2 or something
    PBar 0
    PBar "Checking datasource 2..." 'updates with new text
    'Some code that checks datasource 2a
    PBar 50
    'Some code that checks datasource 2b
    PBar 100
    PBar 'clears statusbar and resets to default application messages
    'continue...

For a non-made-up example, here is how I used it when looping through checking HTTP requests:

'Loop through dates going from today backwards (up to defined limit)
'   until a good response is found.
'If bad credentials or scope limit reached, exit and throw an error
    i = 0 'reset i
    DoCmd.Hourglass True 'changes cursor to hourglass
    Do
        lngDate = Date - i
        strDate = Format(lngDate, "DD_MM_YYYY")
        PBar "Checking " & StrConv(strBrand, vbProperCase) & " " & strDate & "..."
        PBar ((i / intDays) * 100)
        Call HTTPFileGetInfo( _
            strSrcURL_p1 & strDate & strSrcURL_p2, _
            DecryptStr(strCryptUsr), _
            DecryptStr(strCryptRPI))
        Debug.Print _
            "Dealer List Import... b:"; Left(strBrand, 1); ", i:"; i; ", s:"; _
            WHRStatus; ", d:"; lngDate & " = " & strDate
        i = i + 1
        If WHRStatus = ProxyPW Then Exit Do
    Loop Until WHRStatus = OK Or i - 1 >= intDays
    PBar 100
    PBar 'clear
    DoCmd.Hourglass False 'changes cursor to default

'Check the status result from loop and act appropriately
    If WHRStatus = ProxyPW Then GoTo Status_ProxyPW
    If WHRStatus = NotFound Then GoTo Status_NotFound
    If WHRStatus = OK Then GoTo Cont1_Proc:
    GoTo Status_Error 'if none of the above

Cont1_Proc:

Enjoy