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:

RD contextual status bar

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

Identifier under the cursor is not recognized

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:

FoundMatch != MatchFound

---

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

• Kaz: Eh, I prefer to always put my Ifs in blocks, even when they could go on one, line. That way, when I see an If, I always know where to look to find out what it does.
• Mathieu Guindon: Fair enough, but it doesn't excuse = True ;-)
• Comintern: Just the fully qualified early bound reference suggestion (Scripting.Dictionary) is enough for an up-vote. This is actually a perfect example for why you should do this. Drop the class in a Word document and you'll get a cryptic "Invalid use of New keyword" compiler error on Set .StringsToMatch = New Dictionary - Dictionary will default to Word.Dictionary, which isn't creatable...

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.}