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