2
\$\begingroup\$

This is a subroutine I have written as a part of an Excel VBA script. I usually write vb.net or Python but I need the final results for this project in Excel so I'm using VBA.

My initial task is to get the latest 5-100 folders by date last modified (user selects the number of folders). Looking at this question on SO, I found out how to get a list of folders and store it in the cells in excel with the date last modified. This can then be sorted by date modified and I can then work my way down the list for however many folders the user selected.

The code puts this list into a new sheet called Folders, clearing out any old versions if needed.

I can't help but feel that storing the list in cells isn't the best way to do it. I would have thought it would be better to have it in some sort of dictionary or list but I could be mistaken.

Currently, there are around 1000 subfolders in the directory to search and this could potentially grow over 10,000 in the future. Will this approach still work well with that many folders?

Are there any other general improvements I could make?

Sub Get_Sorted_Folder_List(results_dir As String)

    ' Var Declarations
    Dim fso As New FileSystemObject
    Dim fs_folder As Folder
    Dim folder_sheet As Worksheet

    ' Setup "Folders" worksheet
    ' Detect if it already exists, delete if it does
    Application.DisplayAlerts = False
    Err.Clear
    On Error Resume Next
    Set folder_sheet = Sheets("Folders")
    If Err = 0 Then folder_sheet.Delete
    On Error GoTo 0

    ' Create new Folders sheet
    Set folder_sheet = ThisWorkbook.Sheets.Add(After:= _
                            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    folder_sheet.Name = "Folders"
    folder_sheet.Select
    Range("A1").Select
    Columns(1).ColumnWidth = 10
    Columns(2).ColumnWidth = 18

    ' Get list of files
    Set fs_folder = fso.GetFolder(results_dir)
    Dim counter As Integer
    counter = 0

    For Each Folder In fs_folder.SubFolders
        counter = counter + 1
        Cells(counter, 1).Value = Folder.Name
        Cells(counter, 2).Value = Folder.DateLastModified
    Next

    ' Sort newest to oldest
    folder_sheet.Sort.SortFields.Clear
    folder_sheet.Sort.SortFields.Add Key:= _
        Range(Cells(1, 2), Cells(counter, 2)), SortOn:=xlSortOnValues, _
        Order:=xlDescending, DataOption:=xlSortNormal

    With folder_sheet.Sort
        .SetRange Range(Cells(1, 1), Cells(counter, 2))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
\$\endgroup\$
2
  • \$\begingroup\$ (Much as I keep harping document in the code, ' Var Declarations doesn't (the rest of the bunch looks helpful).) \$\endgroup\$
    – greybeard
    Aug 10 '17 at 12:51
  • \$\begingroup\$ @greybeard sorry I don't follow, can you elaborate please? \$\endgroup\$ Aug 10 '17 at 13:02
2
\$\begingroup\$

I think what you have in your code will largely work, though I would comment on a few of your habits that should be addressed to safeguard your code against future potential problems. My implementation of a sorted directory list is somewhat different though, so please stick with me to see if you feel the difference is worth it.

  1. Always use Option Explicit in your code
  2. Never assume the worksheet - this can lead to code that looks like it should work, but will fool you for hours trying to track down why it sometimes doesn't
  3. Descriptive comments vs unhelpful comments - as @greybeard mentioned, comments should enlighten the reader, rather than just supply a useless extra line. As an example, you have
 ' Var Declarations
 Dim fso as New FileSystemObject
 Dim fs_folder as Folder
 Dim folder_sheet as Worksheet

Your comment in this case only restates the VERY obvious fact that you're declaring variables here. That's unhelpful and unnecessary. But if you feel it's needed to clarify or help understand the code, adding a comment that describes "why" you need the following section is often helpful. For example, if I were to show you this section of code, you can easily see what is being done, but it's not exactly clear WHY:

 Dim timestamp As Date
 timestamp = DateValue(FileDateTime(rootPath & thisFolder)) & " " & _
                      TimeValue(FileDateTime(rootPath & thisFolder))
 theseFolders.Add rootPath & thisFolder, timestamp

But if I add this brief comment before the same code, it greatly clarifies why I'm storing the timestamp as the Item. The comment takes the guesswork or assumptions out of the reading.

 '--- folders will be sorted later by the last modified timestamp, 
 '    stored as the Item in each Dictionary entry. each entry Key
 '    is the folder path itself
 Dim timestamp As Date
 timestamp = DateValue(FileDateTime(rootPath & thisFolder)) & " " & _
                      TimeValue(FileDateTime(rootPath & thisFolder))
 theseFolders.Add rootPath & thisFolder, timestamp

So, on to my example...

I decided to use the Dir and FileDateTime built-in VBA functions in a recursive routine to build my Dictionary of folder information. Though I rarely use recursion, I think it applies well in this situation and makes for cleaner and more compact code. The routine uses a top-level Dictionary supplied by the original caller to populate an unsorted list of folders. This top-level Dictionary is built up at each level. But each time the routine is called, it uses a "local" Dictionary just to keep of list of ONLY those folders at this particular level. I thought it would get confusing to combine it all immediately into a single Dictionary.

Private Sub GetFolderList(ByVal rootPath As String, ByRef allFolders As Dictionary)
    Dim theseFolders As Dictionary
    Set theseFolders = New Dictionary

    '--- run through all the files and folders at this level in the directory tree
    '    and make a quick (local) list. the list will be used later to drill down
    Dim thisFolder As String
    On Error Resume Next
    thisFolder = Dir(rootPath, vbNormal + vbDirectory)
    Do While thisFolder <> vbNullString
        If (Left(thisFolder, 1) <> ".") Then
            If (GetAttr(rootPath) And vbDirectory) = vbDirectory Then
                '--- folders will be sorted later by the last modified timestamp, 
                '    stored as the Item in each Dictionary entry. each entry Key
                '    is the folder path itself
                Dim timestamp As Date
                timestamp = DateValue(FileDateTime(rootPath & thisFolder)) & " " & _
                            TimeValue(FileDateTime(rootPath & thisFolder))
                theseFolders.Add rootPath & thisFolder, timestamp
            End If
        End If
        thisFolder = Dir()
    Loop

    '--- now use the folder list to drill down another level for each
    '    folder at this level
    Dim thisKey As Variant
    For Each thisKey In theseFolders.Keys
        allFolders.Add thisKey, theseFolders(thisKey)
        GetFolderList thisKey & "\", allFolders
    Next thisKey
End Sub

The top-level calling routine makes it easy to call the GetFolderList routine. The sorting is something I leave to folks much smarter than I. So I created a separate module with the code from Jon Peltier, both the SortDictionary routine from this page, and the required QSortInPlace from this page. Reduces the sorting now to a single procedure call.

So the whole example module in a single copy-paste is:

Option Explicit

Sub Test()
    Dim folderList As Dictionary
    Set folderList = New Dictionary

    Dim path As String
    path = "C:\Program Files\"

    GetFolderList path, folderList
    SortDictionary folderList, SortByKey:=False

    Debug.Print "--------- Results ---"
    Debug.Print "total folders in list = " & folderList.Count

    'Dim ffolder As Variant
    'For Each ffolder In folderList
    '    Debug.Print ffolder & " - " & folderList(ffolder)
    'Next ffolder
End Sub

Private Sub GetFolderList(ByVal rootPath As String, ByRef allFolders As Dictionary)
    Dim theseFolders As Dictionary
    Set theseFolders = New Dictionary

    '--- run through all the files and folders at this level in the directory tree
    '    and make a quick (local) list. the list will be used later to drill down
    Dim thisFolder As String
    On Error Resume Next
    thisFolder = Dir(rootPath, vbNormal + vbDirectory)
    Do While thisFolder <> vbNullString
        If (Left(thisFolder, 1) <> ".") Then
            If (GetAttr(rootPath) And vbDirectory) = vbDirectory Then
                '--- folders will be sorted later by the last modified timestamp, 
                '    stored as the Item in each Dictionary entry. each entry Key
                '    is the folder path itself
                Dim timestamp As Date
                timestamp = DateValue(FileDateTime(rootPath & thisFolder)) & " " & _
                            TimeValue(FileDateTime(rootPath & thisFolder))
                theseFolders.Add rootPath & thisFolder, timestamp
            End If
        End If
        thisFolder = Dir()
    Loop

    '--- now use the folder list to drill down another level for each
    '    folder at this level
    Dim thisKey As Variant
    For Each thisKey In theseFolders.Keys
        allFolders.Add thisKey, theseFolders(thisKey)
        GetFolderList thisKey & "\", allFolders
    Next thisKey
End Sub

By using C:\Program Files\ as the test directory, it generated a list of over 9,035 folders. It took about 30 seconds to process all of them.

\$\endgroup\$
2
  • \$\begingroup\$ Thank you very much for the review Peter. I only need the top level folder list, I believe this would be achieved by commenting out the recursive call, correct? \$\endgroup\$ Aug 12 '17 at 9:24
  • 1
    \$\begingroup\$ Yes, if you comment out the recursive section -- or better yet, add an input parameter to the Sub as a boolean flag that will optionally recurse down the directory tree. Using the option flag then will keep the flexibility for the future. \$\endgroup\$
    – PeterT
    Aug 12 '17 at 13:43
2
\$\begingroup\$

A couple of general things (in addition to what Vogel said about using explicit references):

  • Consider avoiding the "On Error" statements and using a short/reusable "sheetExists" function instead. Something like this:

    Function sheetExists(wb As Workbook, wsName As String) As Boolean
        Dim tempBool As Boolean
        tempBool = False
        Dim ws As Worksheet
        For Each ws In wb.Sheets
            If ws.Name = wsName Then
                tempBool = True
                Exit For
            End If
        Next
        sheetExists = tempBool
    End Function
    
  • Avoid select statements, which slow down your code and make it less readable. For example:

    'This section...
    folder_sheet.Select
    Range("A1").Select
    Columns(1).ColumnWidth = 10
    Columns(2).ColumnWidth = 18
    '...could be rewritten as:
    With folder_sheet
        .Columns(1).ColumnWidth = 10
        .Columns(2).ColumnWidth = 18
    End With
    
  • Read the folder information into an array and write it to the workbook all at once, instead of writing one value at a time. This will greatly improve performance, especially once you start getting into the thousands of folders.

    'Old version
    Set fs_folder = fso.GetFolder(results_dir)
    Dim counter As Integer
    counter = 0
    
    For Each Folder In fs_folder.SubFolders
        counter = counter + 1
        Cells(counter, 1).Value = Folder.Name
        Cells(counter, 2).Value = Folder.DateLastModified
    Next
    
    'New version
    Set fs_folder = fso.GetFolder(results_dir)
    ReDim subFolderArr(1 To fs_folder.SubFolders.Count, 1 To 2) As Variant
    
    Dim counter As Long
    counter = 0
    For Each Folder In fs_folder.SubFolders
        counter = counter + 1
        subFolderArr(counter, 1) = Folder.Name
        subFolderArr(counter, 2) = Folder.DateLastModified
    Next
    
    With folder_sheet
        .Range(.Cells(1, 1),.Cells(counter, 2)) = subFolderArr
    End With
    

Overall, here's what the finished product would look like (it took 36.5 seconds to complete in a directory with 100k test subfolders):

Sub Create_Sorted_Folder_List(results_dir As String)

    'Create/clear data from results sheet
    Dim folder_sheet As Worksheet
    If sheetExists(ThisWorkbook, "Folders") Then
        Set folder_sheet = ThisWorkbook.Sheets("Folders")
        folder_sheet.Cells.Clear
    Else
        Set folder_sheet = ThisWorkbook.Worksheets.Add
        folder_sheet.Name = "Folders"
    End If

    'Get subfolder list, add data to sheet, and create table
    Dim fileArr As Variant
    fileArr = getSubfolderList(results_dir)

    With folder_sheet
        .Range("A1") = "File Name"
        .Range("B1") = "Date Modified"
        .Range(.Cells(2, 1), .Cells(UBound(fileArr, 1) + 1, 2)) = fileArr
        .ListObjects.Add(xlSrcRange, .Range(.Cells(1, 1), _
                                            .Cells(UBound(fileArr, 1) + 1, 2)), , xlYes).Name = "ResultsTable"
    End With

    Dim resultsTbl As ListObject
    Set resultsTbl = folder_sheet.ListObjects("ResultsTable")

    'Sort and format table
    With resultsTbl
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.ListColumns("Date Modified").Range, _
                        SortOn:=xlSortOnValues, _
                        Order:=xlDescending, _
                        DataOption:=xlSortNormal
        .Sort.Apply
        'Set column widths manually...
        .ListColumns("File Name").Range.ColumnWidth = 10
        .ListColumns("Date Modified").Range.ColumnWidth = 18
        '...or just autofit instead
        '.Range.Columns.Autofit
    End With

End Sub
Function getSubfolderList(sourcePath As String) As Variant
'Creates array of subfolders in the first level of a directory (sourcePath)
'Stores name/date modified of each subfolder

    Dim fso As Object
    Set fso = CreateObject("Scripting.Filesystemobject")

    ReDim subfolderArr(1 To fso.GetFolder(sourcePath).Subfolders.Count, 1 To 2) As Variant
    Dim i As Long
    i = 0
    Dim subF As Object
    For Each subF In fso.GetFolder(sourcePath).Subfolders
        i = i + 1
        subfolderArr(i, 1) = subF.Name
        subfolderArr(i, 2) = subF.DateLastModified
    Next

    getSubfolderList = subfolderArr

End Function
Function sheetExists(wb As Workbook, wsName As String) As Boolean
'Determines whether a sheet with a given name (wsName) exists in a workbook (wb)

    Dim ws As Worksheet
    Dim tempBool As Boolean
    tempBool = False
    For Each ws In wb.Sheets
        If ws.Name = wsName Then
            tempBool = True
            Exit For
        End If
    Next
    sheetExists = tempBool

End Function
\$\endgroup\$
2
  • \$\begingroup\$ Thanks for the review Daniel, some good performance tips I will definitely make use of. One question though, what is the purpose of the tempBool? Why not assign straight to sheetExists? \$\endgroup\$ Aug 12 '17 at 9:33
  • \$\begingroup\$ The idea is that you want to stop the loop and return "True" if you find a sheet with that name, and return "False" if you make it through the loop without finding a match. But there are definitely multiple ways to write that section. You could avoid using the tempBool variable by replacing the "tempBool = True" with "sheetExists = True", and replacing the "Exit For" with "Exit Function". Then you'd replace the last "sheetExists = tempBool" with "sheetExists = False". I find my way slightly easier to read, but that's just a personal preference. \$\endgroup\$ Aug 13 '17 at 18:39
1
\$\begingroup\$

The first thing you should try to do is to make this code look cleaner and subdivide the Get_Sorted_Folder_List into separate reusable steps.

What can help you here is the sections and comments you already have in your code:

Consider the following:

Sub Delete_Sheet(sheet_name As String)
    Dim oldAlerts As Boolean
    oldAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False

    Err.Clear
    On Error Resume Next
    Dim sheet As Worksheet
    Set sheet = Worksheets(sheet_name)
    If Err = 0 Then sheet.Delete
    Err.Clear
    On Error GoTo 0

    Application.DisplayAlerts = oldAlerts
End Sub

This encapsulates the sheet deletion logic into a named method, that you can reuse for ... deleting the accounting sheet?

I additionally included code to restore the previous state of the Application. Additionally I referred to Worksheets instead of Sheets, which is more appropriate, since Sheets can also contain things that are not in fact Worksheets.

As an additional note: You should consider explicitly qualifying the access to Sheets (or Worksheets) with either ThisWorkbook or an additional parameter. You can even go so far as to do:

Sub Delete_Sheet(sheet_name As String, Optional workbook As Workbook = ThisWorkbook)

This pattern carries over into methods named something like Create_Sheet, Layout_Folder_Sheet, Get_File_List, Sort_Sheet.


In addition to extracting methods, you should get into the habit of explicitly qualifying calls to Cells, Range, Columns, Sheets, ...

This enables you to not rely on the notoriously slow and error-prone Selection.

Furthermore it makes code significantly easier to read when you declare variables as close as possible to their usage (I like that you declared all your variables, btw.) and following the conventions of the standard library.
All built-in functions follow UpperCamelCase, why are yours in Upper_Snake_Case?

Also following directly from UpperCamelCase for "public members", most people generally prefer lowerCamelCase for local variables and private members.

\$\endgroup\$
1
  • \$\begingroup\$ Thanks for the review Vogel, the separating out the delete sheet sub is something I'm slightly annoyed at myself for not doing as I've just realised I do use that code twice so it would remove a few lines of duplicate code. The underscores in names is a habit I picked up from someone who taught me some Python and I found it easier to read. Similar story for the variable declaration. \$\endgroup\$ Aug 12 '17 at 9:30

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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