Recursive Directory Searching For Filenames

Question

Purpose:

Given a target folder, and a list of target sub-strings, determine if the folder (or any of its' sub-folders) has a filename which contains any of the target substrings.

---

N.B. This class uses Early-Binding and requires a reference to Microsoft Scripting Runtime

---

Properties:

    RootFolder As Folder
    StringsToMatch As Dictionary
    FoldersRecursed As Dictionary
    matchFound As Boolean
    MatchedFilePath As String

---

Exposed Methods:

AddTargetSubstring()
ClearTargetSubstrings()
SearchFolderForMatch()

---

Private Methods:

RecurseFolderForMatch()
NameContainsAnyTargetSubstring()

---

Program Flow:

Essentially all of the work is done by RecurseFolderForMatch, which works thus:

'/ Search all filenames in the folder for a substring match
'/ If there is no match, iterate sub-folders
'/ For each subfolder, call RecurseFolderForMatch
'/ Short-Circuit if This.MatchFound gets set to True

---

Example Usage:

Set folderSearch = New CLS_Search_Folder
With folderSearch
    .RootFolder = targetFolder
    .AddTargetSubstring "Signed Updated Client Agreement"
    .AddTargetSubstring "Signed Joint Client Agreement"
    .AddTargetSubstring "Signed Client Agreement"
    .AddTargetSubstring "Signed TOB"
    .AddTargetSubstring "Signed Terms Of Business"
    .SearchFolderForMatch

    If .FoundMatch Then

        ...

---

CLS_Search_Folder

    Option Explicit

    Private Type SearchProperties
        RootFolder As Folder
        StringsToMatch As Dictionary
        MatchFound As Boolean
        MatchedFilePath As String
    End Type
    Private this As SearchProperties

    Public Property Get FoundMatch() As Boolean
        FoundMatch = this.MatchFound
    End Property

    Public Property Let RootFolder(ByRef inObject As Folder)
        Set this.RootFolder = inObject
    End Property
    Public Property Get RootFolder() As Folder
        Set RootFolder = this.RootFolder
    End Property

    Public Property Get MatchedFilePath() As String
        MatchedFilePath = this.MatchedFilePath
    End Property

    Public Sub AddTargetSubstring(ByVal inValue As String)

        With this

            If .StringsToMatch Is Nothing Then
                Set .StringsToMatch = New Dictionary
            End If
            .StringsToMatch.item(inValue) = inValue

        End With

    End Sub

    Public Sub ClearTargetSubstrings()

        Set this.StringsToMatch = Nothing

    End Sub

    Public Sub SearchFolderForMatch()

        With this

            .MatchFound = False
            .MatchedFilePath = vbNullString

            If .RootFolder Is Nothing Or .StringsToMatch Is Nothing Then
                PrintErrorMessage "Error: Target Folder Not Initialised or Target Substrings not supplied"
            Else
                RecurseFolderForMatch .RootFolder
            End If

        End With

    End Sub

    Private Sub RecurseFolderForMatch(ByRef folderToRecurse As Folder)
        '/ Search all filenames in the folder for a substring match
        '/ If there is no match, iterate sub-folders
        '/ For each subfolder, call RecurseFolderForMatch
        '/ Short-Circuit if This.MatchFound gets set to True

        Dim MatchFound As Boolean
        Dim iFile As File
        For Each iFile In folderToRecurse.Files

            MatchFound = NameContainsAnyTargetSubstring(iFile.name)

            If MatchFound Then
                this.MatchFound = True
                this.MatchedFilePath = iFile.Path
                GoTo EndRecursion
            End If

        Next iFile

        '/No file match found. Recurse Sub-folders
        Dim iFolder As Folder
        For Each iFolder In folderToRecurse.SubFolders

            If this.MatchFound = True Then
                GoTo EndRecursion '/ Short-Circuit if a sub-folder found a match
            End If

            RecurseFolderForMatch iFolder

        Next iFolder

EndRecursion:

    End Sub

    Public Function NameContainsAnyTargetSubstring(ByVal nameToCheck As String)

        Dim MatchFound As Boolean
        Dim key As Variant
        Dim stringToFind As String
        For Each key In this.StringsToMatch.Keys()
            stringToFind = CStr(key)
            MatchFound = (InStr(1, nameToCheck, stringToFind, vbTextCompare) > 0)
            If MatchFound Then
                GoTo EndCheck
            End If
        Next key

EndCheck:
        NameContainsAnyTargetSubstring = MatchFound

    End Function

Answer 1

Your example usage is needlessly complicated:

Dim folderSearch As CLS_Search_Folder
Set folderSearch = New CLS_Search_Folder
With folderSearch
    'do your thing
End With

There's no need to even declare a local variable, just have the With block hold the reference instead:

With New CLS_Search_Folder
    'do your thing
End With

I don't like the CLS prefix and underscores in the class' name - I don't see a reason not to just call it FolderSearch:

With New FolderSearch
    'do your thing
End With

The VBE's project explorer already regroups modules by type, which means everything under the "Class Modules" folder will have that CLS prefix - what's the use then?

---

Whenever referring to early-bound types, it's usually a good idea to qualify them with the library they're from - e.g. ADODB.Recordset, Scripting.Dictionary, etc.

...unless you have Rubberduck's contextual status bar to spoil you with immediate knowledge of what's coming from where:

Otherwise all you get is this when you try Shift+F2 / "go to definition":

And only then you resort to the object browser to search for that Folder type in all referenced libraries.

---

Nitpick: I think the API / exposed members are too verbose, I would change SearchFolderForMatch to simply Search, or even Execute.

---

This doesn't look right:

Public Property Let RootFolder(ByRef inObject As Folder)
    Set this.RootFolder = inObject
End Property

It's an object reference, so it should be Property Set, not Property Let - and it could be passed by value still; it's just an object reference.

---

This is wrong:

PrintErrorMessage "Error: Target Folder Not Initialised or Target Substrings not supplied"

That's a dependency on an outside procedure, and the class itself shouldn't be responsible for handling such errors - that error should be bubbled up and handled by the client code, because it's not an error that the object is supposed to know how to handle - the object's job is to search folders, not print stuff to the debug output (or does that method log stuff in a database? or in a text file? or does it display a MsgBox?). Consider raising a custom error there.

---

Function NameContainsAnyTargetSubstring returns an implicit Variant; the signature should end with As Boolean.

It's also Public, but you're listing it as a private method in the OP. Glitch?

Dim MatchFound As Boolean

Avoid clashing names - you have MatchFound a member of the SearchProperties UDT already, so consider MatchFound taken as a public member's name. I'd go with isFound, or simply result here.

It's a bit off-putting and inconsistent that the public property backed by that MatchFound UDT member is called FoundMatch, given how every other property has the exact same name as its backing UDT member:

---

There's no reason for = True here:

If this.MatchFound = True Then

There are several spots where you have opted for an If...End If block when an If...Then statement would have been just fine - for example:

If this.MatchFound Then GoTo EndRecursion

Answer 2

A couple things I noticed - all of your public methods rely on this.StringsToMatch being initialized. You're using Is Nothing as basically a proxy for .Count = 0. Since the behavior of the class depends on having an initialized container, just create it once in Class_Initialize:

Private Sub Class_Initialize()
    Set this.StringsToMatch = New Scripting.Dictionary
End Sub

Then you can replace ClearTargetSubstrings with the much more natural...

Public Sub ClearTargetSubstrings()
    this.StringsToMatch.RemoveAll
End Sub

...and .StringsToMatch Is Nothing with the much clearer .StringsToMatch.Count = 0.

---

Along those same lines, I've always disliked the Scripting.Dictionary behavior of adding an item as a side-effect of calling .Item(foo) = bar if foo doesn't exist. In my mind this should be an error, so it looks like an error at first glance. Just because Microsoft made a bad implementation decision doesn't mean you have to rely on their poor implementation at the expense of your readability. If you always have a .StringsToMatch hanging around, you can make AddTargetSubstring a lot clearer as to what it is actually doing:

Public Sub AddTargetSubstring(ByVal inValue As String)
    With this.StringsToMatch
        If Not .Exists(inValue) Then
            .Add inValue, vbNull
        End If
    End With
End Sub

Note that this also allows you to add an additional dereference level to your With block.

---

Note above that I set the key, but left the item as vbNull. If the key and the item are always the same, there isn't any reason to store 2 copies of it. You are basically using the Scripting.Dictionary as a simple hashset, so just use the part .Keys() that actually is the hashset. Save the memory and hassle of actually storing copies as the .Item.

---

I'll diverge a bit from @Mat'sMug's recommendation to have errors bubble up to the calling code. The class is simple enough that I wouldn't even be raising errors about its state. If you require that this.RootFolder is set, make the property read-only and make a Scripting.Folder a required parameter of SearchFolderForMatch instead. If you don't have any sub-strings to search, pick a default behavior (like returning vbNullString for MatchedFilePath or matching any file) and do that instead of raising an error. That allows the calling code much more flexibility and removes the requirement for the caller to have to establish a valid object state before using certain (in this case 1) methods.

---

Short nit-pick break (and this is entirely a personal style preference) - I find the "out-dented" GoTo labels distracting. The vast, vast majority of code that I see has them simply pinned to the left margin where the VBE puts them. Having them at a different indentation level makes think that they are acting as a closure, so it actually takes a bit of mental effort for me when I see this:

EndRecursion:

    End Sub

    Public Function NameContainsAnyTargetSubstring(ByVal nameToCheck As String)
       '...

EndCheck:

The fact that they all start with End makes it even worse. My brain does something like End Sub, End Function, EndCheck, ...WTF?

---

Finally, you have a pretty decent performance opportunity in NameContainsAnyTargetSubstring. You are comparing every single file to the same set of keys, so I'd consider converting it to just build a RegExp pattern and using that instead. Just getting rid of files * substrings extraneous string casts with the line stringToFind = CStr(key) is worth it alone.

I'd do something more like this. Make NameContainsAnyTargetSubstring a simple wrapper function (mainly to avoid having to recreate the regex pattern repeatedly):

'Class level variable.
'Requires reference to Microsoft VBScript Regular Expressions 5.5
Private substringRegex As VBScript_RegExp_55.RegExp 

Private Sub Class_Initialize()
    Set this.StringsToMatch = New Scripting.Dictionary
    Set substringRegex = New VBScript_RegExp_55.RegExp
    substringRegex.IgnoreCase = True
End Sub

...and down below:

Private Sub SetRegexPattern()
    substringRegex.Pattern = "(" & Join(this.StringsToMatch.Keys, ")|(") & ")"
End Sub

Public Function NameContainsAnyTargetSubstring(ByVal nameToCheck As String) As Boolean
    If this.StringsToMatch.Count = 0 Then Exit Function 'Or whatever default.
    SetRegexPattern
    NameContainsAnyTargetSubstring = substringRegex.Test(nameToCheck)
End Function

Private Sub RecurseFolderForMatch(ByRef folderToRecurse As Folder)
    SetRegexPattern

    Dim candidate As File
    For Each candidate In folderToRecurse.Files
        With candidate
            this.MatchFound = substringRegex.Test(.Name)
            If this.MatchFound Then
                this.MatchedFilePath = .Path
                Exit Sub
            End If
        End With
    Next

    Dim subFolder As Folder
    For Each subFolder In folderToRecurse.SubFolders
        RecurseFolderForMatch subFolder
        If this.MatchFound = True Then
            Exit Sub
        End If
    Next
End Sub

^{You can probably just leave the VBScript_RegExp_55 off the declaration of RegExp - pedantic mode was on solely to avoid the appearance of hypocracy.}