6
\$\begingroup\$

I need to get folder names with the path for which I need to search the directory in a server with about 6000 folders. I have the following snippet of code to run through the folder and get the folder names with path. It works fine in a local directory but when I run the same code on a server directory it fails after about printing 86 folder names. The code works absolutely fine but stops working when run on a server directory with about 6000 folders. Excel freezes up and seems like it hangs.

Private Sub PrintFolders()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer
Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Temp")
i = 1
'loops through each folder in the directory and prints their names and path
On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler
MsgBox "This may take a long time: press ESC to cancel"
For Each objSubFolder In objFolder.subfolders
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
    'print folder name
    Cells(i + 1, 1) = objSubFolder.Name
    'print folder path
    Cells(i + 1, 2) = objSubFolder.Path
    i = i + 1
Next objSubFolder
handleCancel:
If Err = 18 Then
 MsgBox "You cancelled"
End If
End Sub
\$\endgroup\$
  • 1
    \$\begingroup\$ I'm on the fence here. The code works... but fails because I presume the folder names get too long. Do they? It's impossible to tell just by looking at the code, but I suggest you also print the length of the subfolder names you're getting. If it's too deep and folder names get longer than [what I think I remember as being] 240 characters, that's where it blows up. You need to handle runtime errors here. Basically if handling long folder names is part of your spec, this code doesn't work as intended and thus, isn't ready to be peer reviewed on this site. Good luck! \$\endgroup\$ – Mathieu Guindon Apr 9 '15 at 20:20
  • \$\begingroup\$ The code works absolutely fine.. but it hangs when the script is run on a server location where I have around 6000 folders. I am not sure why it takes so much time hence I posted here for optimization \$\endgroup\$ – Anurag Singh Apr 9 '15 at 20:24
  • 2
    \$\begingroup\$ I've retracted my close vote, buy I strongly recommend you edit your post to make it clearer that it just appears to hang and actually works, since questions involving non-working code tend to quickly get closed on this site. \$\endgroup\$ – Mathieu Guindon Apr 9 '15 at 20:49
  • \$\begingroup\$ I have modified the code as well to handle error and enable cancel key but status bar doesn't update after some time and pressing escape also doesn't get me out of the loop. \$\endgroup\$ – Anurag Singh Apr 9 '15 at 21:59
  • 1
    \$\begingroup\$ See this related issue on Stack Overflow. FSO can be slower than using the native APIs. \$\endgroup\$ – Comintern Apr 10 '15 at 0:31
8
\$\begingroup\$

UX

Before diving into the code, I have a few points to mention about the user experience of it.

  • You're not resetting the Application.Statusbar before the procedure exits, which means whenever the code runs to completion, the Excel status bar remains "frozen" with the last processed folder.
  • You're warning the user that the operation may take a long time, regardless of how many folders/subfolders there actually are.
  • Message boxes are bare-bones, without a title or an icon, and punctuation is missing from the message strings.

Readability

The code itself reads a bit like a clogged script. Indentation is insufficient and inconsistent, and vertical whitespace is completely inexistent. This code needs to breathe a little - here's your code, without any other changes:

Private Sub PrintFolders()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim i As Integer

    Application.StatusBar = ""

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder("C:\Temp")

    i = 1
    'loops through each folder in the directory and prints their names and path
    On Error GoTo handleCancel

    Application.EnableCancelKey = xlErrorHandler
    MsgBox "This may take a long time: press ESC to cancel"

    For Each objSubFolder In objFolder.subfolders
        Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
        'print folder name
        Cells(i + 1, 1) = objSubFolder.Name
        'print folder path
        Cells(i + 1, 2) = objSubFolder.Path
        i = i + 1
    Next objSubFolder

handleCancel:
    If Err = 18 Then
        MsgBox "You cancelled"
    End If

End Sub

Comments

There are way too many comments in that code. Good, valuable comments explain why code is doing what it does - the code itself should be self-explanatory about the what.

I would simply remove them... all.

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

Isn't too far from:

'increment i:
i = i + 1

Non-Responsiveness

You're running a pretty tight loop here:

For Each objSubFolder In objFolder.subfolders

    Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
    Cells(i + 1, 1) = objSubFolder.Name
    Cells(i + 1, 2) = objSubFolder.Path

    i = i + 1

Next objSubFolder

You never give Excel a chance to breathe and actually respond to the events you're sending - namely updating the statusbar and listening to ESC keypresses.

This would fix it:

For Each objSubFolder In objFolder.subfolders

    Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
    Cells(i + 1, 1) = objSubFolder.Name
    Cells(i + 1, 2) = objSubFolder.Path

    i = i + 1
    DoEvents

Next objSubFolder

...but it comes with a pretty high price: updating the status bar and listening for keypresses at each and every iteration will considerably slow down execution. How about reorganizing it a little, and only do that once every 10 iterations? Avoid magic numbers, give that value a meaningful name and assign it to a constant:

Const IterationsToUpdate As Integer = 10
For Each objSubFolder In objFolder.subfolders

    Cells(i + 1, 1) = objSubFolder.Name
    Cells(i + 1, 2) = objSubFolder.Path

    i = i + 1

    If i Mod IterationsToUpdate = 0 Then
        Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
        DoEvents
    End If

Next objSubFolder

Now, you're writing to worksheet cells in a loop, while keeping Excel relatively responsive. Are you sure you're writing to the correct worksheet?

Cells(i + 1, 1) = objSubFolder.Name
Cells(i + 1, 2) = objSubFolder.Path

Without an object reference, Cells is referring to the active sheet, which the user is free to change any time as the code runs. This is another UX issue if not a bug.


Performance

I'm willing to bet anything that your biggest bottleneck isn't the FSO, but actually writing to the cells. Of course you need to do that.. but do you need Excel to repaint its grid and verify that nothing needs to be recalculated every time you write to a cell? Of course you don't.

Switch it off:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Now, whenever you do that, you must handle runtime errors appropriately.


Error Handling

Your error handling is copy-pasted from MSDN, which is only an example to illustrate how a specific feature works - these examples are always focused on a very specific feature, and never about best practices.

Your method should fail cleanly, and correctly cleanup whether or not an error is raised - every error-sensitive method should be templated something like this:

Sub DoSomething()
    On Error GoTo CleanFail

    'implementation code here

CleanExit:
    'cleanup code here
    Exit Sub

CleanFail:
    'error-handling code here
    Resume CleanExit
End Sub

In your case, it would look something like this:

CleanExit:
    Application.Statusbar = False
    Application.Cursor = xlDefault
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub

CleanFail:
    Const MsgTitle As String = "Operation not completed"
    If Err.Number = 18 Then
        MsgBox "Operation was cancelled.", vbInformation, MsgTitle
    Else
        MsgBox "An error has occurred: " & Err.Description, vbCritical, MsgTitle
    End If
    Resume CleanExit

Abstraction & Maintainability

If you need to change the folder to run it for, you need to change the code: it's screaming for a String parameter containing the root path to start searching in.

The procedure is also doing too many things. To add features you need to add more code to it, making it do even more things.

Consider these concerns:

  • Knowing what folder to start searching in
  • Acquiring the folders/subfolders' names
  • Warning the user about a potentially lengthy operation
  • Enabling/disabling/toggling screen updating, calculation, statusbar and cursor
  • Knowing what worksheet to output to
  • Dropping the folders/subfolders' names onto the output worksheet

Most of these concerns deserve a method of their own. Here's how I would write your code:

Option Explicit

Public Sub RenameMe()

    Dim rootPath As String
    rootPath = GetRootPath
    If rootPath = vbNullString Then Exit Sub

    Dim folders() As Variant
    Set folders = FindAllFolders(rootPath)

    Dim targetSheet As Worksheet
    Set targetSheet = Application.ActiveSheet

    OutputFolders targetSheet, folders

End Sub

Split concerns into small, immutable procedures - a procedure should ideally have no more than one reason to change. Doing that increases the abstraction level of your code, which instantly boosts readability, which in turn automatically reduces the possibility for hidden bugs.


Algorithm

If you noticed, the above snippet separates getting the folders and writing them to a worksheet. You may think "but I'll have to iterate all 6,000 folders twice, this is going to be so much slower!"... but I'll give you a hint: read up on Arrays and Ranges in VBA (bookmark that site!).

The crux is that you don't need to iterate anything other than the folders: you populate a 2D array as you go, and then write that entire array onto the worksheet in a single operation. Then your performance bottleneck will be the FileSystemObject, but at that point your code will be so unrecognizeable that it'll be worth posting another Code Review question! :)

\$\endgroup\$
  • 1
    \$\begingroup\$ Thanks Mat!! My code is running now and doesn't freeze up it still takes time to run on a server location with huge number of folders but doesn't freeze up like it was doing before. \$\endgroup\$ – Anurag Singh Apr 10 '15 at 16:46

protected by Jamal Mar 20 at 3:33

Thank you for your interest in this question. Because it has attracted low-quality or spam answers that had to be removed, posting an answer now requires 10 reputation on this site (the association bonus does not count).

Would you like to answer one of these unanswered questions instead?

Not the answer you're looking for? Browse other questions tagged or ask your own question.