List Subdirectories II

There were a couple of good comments on my List Subdirectories post that were worth trying out. The first concerned writing to cells and its effect on speed. In the original code, I computed the next available cell and wrote to it. In the revised code, I store the values in an array and write the array to the range all at once.

Sub ListSubsArr()
    Dim fso As FileSystemObject
    Dim StFldr As Folder
    Dim Fldr As Folder
    Dim aOutput() As String
    Dim lCount As Long
    Set fso = New FileSystemObject
    Set StFldr = fso.GetFolder(“S:ParagonAccounting”)
    lCount = lCount + 1
    ReDim aOutput(1 To lCount)
    For Each Fldr In StFldr.SubFolders
        SFoldersArr Fldr, aOutput, lCount
    Next Fldr
    ActiveSheet.Range(“A1”).Resize(UBound(aOutput), 1).Value = Application.Transpose(aOutput)
    Set StFldr = Nothing
    Set fso = Nothing
End Sub
Sub SFoldersArr(MFldr As Folder, ByRef vOutput As Variant, ByRef lCount As Long)
    Dim SFldr As Folder
    If lCount > UBound(vOutput) Then
        ReDim Preserve vOutput(1 To lCount + MFldr.SubFolders.Count)
    End If
    vOutput(lCount) = MFldr.Path
    lCount = lCount + 1
    If MFldr.SubFolders.Count > 0 Then
        For Each SFldr In MFldr.SubFolders
            SFoldersArr SFldr, vOutput, lCount
        Next SFldr
    End If
End Sub

The second comment suggested using a dos command to list the subdirectories into a text file and then opening the text file in Excel. To wit:

Sub ListSubDos()
    Dim sFname As String
    Dim CommandLine As String
    Dim FileSpec As String
    Dim RedirectTo As String
    Dim dWaitTime As Date
    RedirectTo = “C:a.xls”
    FileSpec = “S:ParagonAccounting”
    On Error Resume Next
        Kill RedirectTo
    On Error GoTo 0
    CommandLine = “dir ““” & FileSpec & _
        “”” /a:d/s/b > ““” & RedirectTo & “”“”
    Shell Environ$(“comspec”) & ” /c “ & CommandLine, vbHide
    dWaitTime = Now + TimeValue(“00:00:01”)
    Loop Until Now > dWaitTime
    Workbooks.Open (RedirectTo)
End Sub

I used the Timer function to see how long all these take to run. I’ve heard the Timer function isn’t hyper accurate, but I think it’s useful for comparison purposes. That is, two subs may not take 3 seconds and 4 seconds respectively, but the first is roughly 25% faster than the second. I don’t know if that’s true, but I’m going with it.

Sub CompTimne()

    Dim lStart As Long
    lStart = Timer
    Debug.Print “ListSubs”, Timer – lStart
    lStart = Timer
    Debug.Print “ListSubsArr”, Timer – lStart
    lStart = Timer
    Debug.Print “ListSubDos”, Timer – lStart
    On Error Resume Next
        Workbooks(“a.xls”).Close False
    On Error GoTo 0
End Sub

ListSubs   3.94921875
ListSubsArr   3.51171875
ListSubDos   1.04296875
ListSubs   3.49609375
ListSubsArr   4.07421875
ListSubDos   2.04296875
ListSubs   4.15234375
ListSubsArr   3.71484375
ListSubDos   1.04296875
ListSubs   3.38671875
ListSubsArr   3.96484375
ListSubDos   1.10546875

There doesn’t seem to be a clear winner between the first two, which surprises me. Maybe the Redim Preserve-ing is what’s slowing it down. How can I make that faster? Also, if you know of a better, built-in way to time subs, let me know.

Posted in Uncategorized

3 thoughts on “List Subdirectories II

  1. >>Maybe the Redim Preserve-ing is what’s slowing it
    >>down. How can I make that faster?

    What I’ve done is add a counter, so the array redims in steps of ten, every tenth time it adds to the array.

Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.