Skip to content

Commit

Permalink
Updated the FindSubFilesAndFolders function to provide visual feedbac…
Browse files Browse the repository at this point in the history
…k via Application.StatusBar that the process is still working. Also adds DoEvents to prevent application not responding. Fixes #2
  • Loading branch information
M-Scott-Lassiter committed Mar 29, 2022
1 parent b8966e1 commit e21d1ab
Show file tree
Hide file tree
Showing 2 changed files with 10 additions and 2 deletions.
12 changes: 10 additions & 2 deletions DirectoryManager.cls
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Version 1.0.1 '
'Version 1.0.2 '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'MIT License '
' '
Expand Down Expand Up @@ -155,10 +155,16 @@ Private Sub FindSubFilesAndFolders()
' and repeats the process.
Dim item As Variant
Dim newFolder As DirectoryManager
Dim originalStatusBarDisplay As Boolean


originalStatusBarDisplay = Application.DisplayStatusBar
Application.DisplayStatusBar = True

For Each item In FoundFoldersList
'For large file/folder counts, Excel appears to freeze. This gives feedback that it's still working.
Application.StatusBar = "Reading from folder '" & item & "'"
DoEvents

Set newFolder = New DirectoryManager
newFolder.OmittedPrefix = OmittedPrefixValue
newFolder.Path = FolderPath & item
Expand All @@ -174,6 +180,8 @@ Private Sub FindSubFilesAndFolders()
InsertCollectionValueAlphabetically FoundFiles, newFolder, newFolder.Name
Next item

Application.DisplayStatusBar = originalStatusBarDisplay

End Sub


Expand Down
Binary file modified ExampleWorkbook.xlsm
Binary file not shown.

0 comments on commit e21d1ab

Please sign in to comment.