Progress Bar

[MelG]

Hi, the code below is to import file names into excel from any given folder. I'd like to have a progress bar but I'm not sure how it would work. I thought if I could work out how many file names are going to be imported before the Macro does it's work, I could use it to do a progress bar showing percentage complete as every file name and path is loaded into the array. Any ideas? The code was not written by me so please go back to basics when replying.

Option Explicit
Dim cnt As Long

Sub ListFiles()
Dim objFSO As FileSystemObject
Dim MyPath As String
Dim MyArray() As String

cnt = 0

Set objFSO = CreateObject("Scripting.FileSystemObject")

Sheets.Add

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Select a Folder"
.Show
'Call UpdateProgressIndicator
If .SelectedItems.Count > 0 Then
MyPath = .SelectedItems(1)
Call ProcessFolders(objFSO, MyPath, MyArray)
Else
Exit Sub
End If
End With
Cells.Clear
If cnt > 0 Then
Range("A1:B1").Value = Array("File Path", "File Name")
Range("A2").Resize(UBound(MyArray, 2), UBound(MyArray, 1)).Value = WorksheetFunction.Transpose(MyArray)
Else
MsgBox "No files were found...", vbExclamation

End If


End Sub

Sub ProcessFolders(ByRef f, ByVal p, ByRef arr)
Dim objFolder As Folder
Dim objSubFolder As Folder
Dim objFile As File
Set objFolder = f.GetFolder(p)
For Each objFile In objFolder.Files
cnt = cnt + 1
ReDim Preserve arr(1 To 2, 1 To cnt)
arr(1, cnt) = objFolder.path
arr(2, cnt) = objFile.Name
Next objFile
For Each objSubFolder In objFolder.SubFolders
Call ProcessFolders(f, objSubFolder, arr)
Next objSubFolder
End Sub

 

[John_w]

You could use this function to count the number of files in the specified folder:

Function CountFiles(fso As FileSystemObject, folderPath As String) As Long

    Dim objFolder As folder
    Dim objSubFolder As folder
    
    Set objFolder = fso.GetFolder(folderPath)
    
    CountFiles = CountFiles + objFolder.Files.Count
    
    For Each objSubFolder In objFolder.SubFolders
        CountFiles = CountFiles + CountFiles(fso, objSubFolder.Path)
    Next
    
End Function

Call it like this:

filesTotal = CountFiles(objFSO, MyPath)

You would call UpdateProgressIndicator in the "For Each objFile In objFolder.Files" loop. Pass as parameters the total number of files and the current file count so that it can calculate and show the percentage complete.

 

[MelG]

Thanks! works a treat!

 

[MelG]

I've got a new problem now. There's something not right with the code I've highlighted in blue. After "frmProgressBar.Show" the progress bar appears on screen and does nothing. If I close the progress bar it runs the rest of the code and then gets stuck in the same place again.

Option Explicit
Dim cnt As Long
Dim Filestotal As Integer
Sub ListFiles()
Dim objFSO As FileSystemObject
Dim MyPath As String
Dim MyArray() As String
Dim objFiles As Object

cnt = 0

Set objFSO = CreateObject("Scripting.FileSystemObject")

Sheets.Add

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Select a Folder"
.Show
If .SelectedItems.Count > 0 Then
MyPath = .SelectedItems(1)

Filestotal = CountFiles(objFSO, MyPath)
MsgBox Filestotal


Call ProcessFolders(objFSO, MyPath, MyArray)
Else
Exit Sub
End If
End With
Cells.Clear
If cnt > 0 Then
Range("A1:B1").Value = Array("File Path", "File Name")
Range("A2").Resize(UBound(MyArray, 2), UBound(MyArray, 1)).Value = WorksheetFunction.Transpose(MyArray)
Else
MsgBox "No files were found...", vbExclamation

End If

End Sub
Sub ProcessFolders(ByRef f, ByVal p, ByRef arr)
Dim objFolder As Folder
Dim objSubFolder As Folder
Dim objFile As File
Set objFolder = f.GetFolder(p)
Dim Percentage, counter As Long
For Each objFile In objFolder.Files
cnt = cnt + 1

frmProgressBar.Show
Percentage = (cnt / Filestotal) * 100
frmProgressBar.ProgressBar1.Value = Percentage
frmProgressBar.LblPercent = Str(Percentage) & "%"

ReDim Preserve arr(1 To 2, 1 To cnt)
arr(1, cnt) = objFolder.path
arr(2, cnt) = objFile.Name
Next objFile
For Each objSubFolder In objFolder.SubFolders
Call ProcessFolders(f, objSubFolder, arr)
Next objSubFolder
End Sub
Function CountFiles(fso As FileSystemObject, folderPath As String) As Long
Dim objFolder As Folder
Dim objSubFolder As Folder

Set objFolder = fso.GetFolder(folderPath)

CountFiles = CountFiles + objFolder.Files.Count

For Each objSubFolder In objFolder.SubFolders
CountFiles = CountFiles + CountFiles(fso, objSubFolder.path)
Next

End Function

 

[Johnny C]

You need to refresh the form. Use either
frmProgressBar..repaint
or
DoEvents

The first only updates the form, the latter makes all calculations/file saves complete and refreshes the form. this will be a tad slower, if you can't notice a difference then go for DoEvents.

 

[MelG]

I've tried the repaint and doevents and still having to close the progress bar to get it to move to the next line of code.

Sub ProcessFolders(ByRef f, ByVal p, ByRef arr)
Dim objFolder As Folder
Dim objSubFolder As Folder
Dim objFile As File
Set objFolder = f.GetFolder(p)
Dim Percentage, counter As Long

frmProgressBar.Show
For Each objFile In objFolder.Files
cnt = cnt + 1
Percentage = (cnt / Filestotal) * 100
frmProgressBar.ProgressBar1.Value = Percentage
frmProgressBar.LblPercent = Str(Percentage) & "%"
DoEvents
ReDim Preserve arr(1 To 2, 1 To cnt)
arr(1, cnt) = objFolder.path
arr(2, cnt) = objFile.Name

Next objFile
For Each objSubFolder In objFolder.SubFolders
Call ProcessFolders(f, objSubFolder, arr)
Next objSubFolder
frmProgressBar.Hide
End Sub

 

[John_w]

Which UserForm progress bar are you using? I've used http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/ successfully.

Post your UserForm code, if any.

 

[Johnny C]

First things first: you need some type conversion functions in there. Maybe it isn't crashing but it's good practice. E.g. Percentage is a long which is a whole number but (cnt / Filestotal) * 100 will usually evaluate to a number with a decimal fraction. So try

Percentage = CLng((cnt / Filestotal) * 100)

Bizarre as it sounds that might fix it; sometimes Excel just stops if you get an error when a form is running. Have you run it without the progress bar updates (see if you get any errors flagged up)?

Also, you aren't setting the property of the label:

frmProgressBar.LblPercent = Str(Percentage) & "%"

should be

frmProgressBar.LblPercent.caption = Str(Percentage) & "%"

Try that and see what happens.

 

[MelG]

I've used the Microsoft Progress bar.
http://digiassn.blogspot.com/2006/03/excel-progress-bar-indicator-with-vba.html

I've already posted all the code I have. My last post is the only part that refers to the progress bar.

I'll have a go at the link you've posted.

 

[Johnny C]

PS I do it the same way John W's link recommends.

However if you don't want a form, there is an ActiveX progress bar object, do a search for that. Downside is you need to enable ActiveX objects each time you open the sheet; if it's just you using it you can set your Excel to automatically allow ActiveX commands.