Search code examples
excelexcel-2013vba

Progress Meter characters not displaying as intended

I'm trying to implement a 'Status Bar Progress Meter' I've found here and implemented this in my code as below:

Private Sub btnFetchFiles_Click()

    Dim j As Integer

        iRow = 20
        fPath = "\\c\s\CAF1\Dragon Mentor Group\Dragon Scripts\Current\April 2015"
        If fPath <> "" Then

            ' make StatusBar visible
            Application.DisplayStatusBar = True
            Set FSO = New Scripting.FileSystemObject
            'First Message
            Application.StatusBar = String(5, ChrW(9609)) & " Working..."
            If FSO.FolderExists(fPath) <> False Then
                'Second Message
                Application.StatusBar = String(10, ChrW(9609)) & " Working..."
                Set SourceFolder = FSO.GetFolder(fPath)
                'Third Message
                Application.StatusBar = String(15, ChrW(9609)) & " Working..."
                IsSubFolder = True
                'Fourth Message
                Application.StatusBar = String(15, ChrW(9609)) & " Still Working..."
                Call DeleteRows
                If AllFilesCheckBox.Value = True Then
                'Fifth Message
                Application.StatusBar = String(15, ChrW(9609)) & " Still Working..."
                    Call ListFilesInFolder(SourceFolder, IsSubFolder)
                    Call ResultSorting(xlAscending, "C20")
                    Call FormatCells
                Else
                    Call ListFilesInFolderXtn(SourceFolder, IsSubFolder)
                    Call ResultSorting(xlAscending, "C20")
                    Call FormatCells
                End If
                'Sixth Message
                Application.StatusBar = String(20, ChrW(9609)) & "Still Working..."
                lblFCount.Caption = iRow - 20
                'Seventh Message
                Application.StatusBar = String(25, ChrW(9609)) & "Almost Done..."
            Else
                MsgBox "Selected Path Does Not Exist !!" & vbNewLine & vbNewLine & "Select Correct One and Try Again !!"
            End If
        Else
            MsgBox "Folder Path Can not be Empty !!" & vbNewLine & vbNewLine & ""
        End If
                'Eigth Message
                Application.StatusBar = String(30, ChrW(9609)) & "All Files Extracted..."
       'Relinquish the StatusBar
        Application.StatusBar = False
    End Sub

You will see in the image below that there is a blue progress meter running from left to right with small rectangles,

but when I run my script, I'm left not with small rectangles but with a continuous white bar as shown here:

Why? Where have I gone wrong?

Solution

  • If you would like, you could replace the bar with a percentage. I typically calculate percentages based on how far through the process the procedure is. In your case you appear to be assigning specific values to your progress, which works as well.

    To implement, it would be as simple as replacing this line in your code:

    Application.StatusBar = String(5, ChrW(9609)) & " Working..."

    With the following:

    Application.StatusBar = "Working... 16% complete"

    (16% because 5/30 from your code).

    If you wanted it to be calculated, you could do the following:

    Application.StatusBar = "Working... " & Round(1 / 6 * 100, 0) & "%"

    You could replace both 1 and 6 with variables as needed.