Skip to main content
added 116 characters in body
Source Link
Kaz
  • 8.8k
  • 2
  • 31
  • 69

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


Properties:

Properties:

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


Properties:

Source Link
Kaz
  • 8.8k
  • 2
  • 31
  • 69

Recursive Directory Searching For Filenames

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.


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