Search for files that contain keywords in folder + subfolders

[Iceshade]

Hi Everyone,

Quite new to VBA and would really appreciate some help please ?

I have a macro in a workbook that when ran, scans a drive that the user selects and looks for all files that contain the keyword provided. Is there anyway to:
1. Get it to scan also the subfolders within the folder selected by the user?
2. Allow for multiple keywords to be searched at one time ?

This is the code:

Sub ListFilesContainingString()
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    getfolder = sItem
    Set fldr = Nothing
   
    wrd = InputBox("Word:", "Insert search word")
    If wrd = "" Then
        MsgBox "???"
        Exit Sub
    End If
   
    strfile = Dir(getfolder & "\*" & wrd & "*")
    fc = 0
    Do While Len(strfile) > 0
        fc = fc + 1
        Cells(fc, 1).Value = strfile
        strfile = Dir
    Loop
   
End Sub

Have been at this for a few days now, just can't seem to change it to work.

Many many thanks in advance for any guidance here please.

 

[Domenic]

Do you want to scan the subfolders recursively (ie. subfolders within subfolders)?

Or do you only want to scan subfolders within your main folder?

 

[Iceshade]

Do you want to scan the subfolders recursively (ie. subfolders within subfolders)?

Or do you only want to scan subfolders within your main folder?

Hi Domenic, thank you for replying sorry it's taken a while to respond.

I have a folder that contains sub folders within subfolders. I would like to scan all subfolders recursively within a folder selected.

Greatly appreciate your response.

 

[Domenic]

The following code uses the FileSystemObject to search the subfolders recursively. And, it uses late-binding, so there's no need to reference the Microsoft Scripting Runtime library. And, of course, make any changes that you desire.

Sub ListFilesContainingSearchTerms()

    Dim folderName As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .InitialFileName = Application.DefaultFilePath & "\" 'change the initial folder as desired
        If .Show = 0 Then Exit Sub 'user cancelled
        folderName = .SelectedItems(1)
    End With
   
    Dim wrd As String
    wrd = InputBox("Insert one or more search terms, separated by a semi-colom (ie. blue;red;green).", "Search Terms")
    If wrd = "" Then
        MsgBox "???", vbQuestion, "Search Terms"
        Exit Sub
    End If
   
    Cells.ClearContents 'clear contents of active worksheet for new list of files
   
    Dim searchTerms As Variant
    searchTerms = Split(Trim(wrd), ";") 'Trim() to remove any leading and trailing spaces, and Split() to split the string into an array
   
    Dim startRow As Long
    startRow = 1 'change the starting row as desired
   
    Dim fileCount As Long
    fileCount = 0
   
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    ProcessFolder fso, folderName, True, searchTerms, startRow, fileCount

    MsgBox "Number of files that match the search terms: " & fileCount, vbInformation, "File Count"
 
    Set fso = Nothing
   
End Sub

Private Sub ProcessFolder(ByVal fso As Object, ByVal folderName As String, ByVal includeSubfolders As Boolean, ByRef searchTerms As Variant, ByRef rowNumber As Long, ByRef fileCount As Long)

    Dim currentFolder As Object
    Dim currentSubFolder As Object
    Dim currentFile As Object
   
    Set currentFolder = fso.GetFolder(folderName)
   
    For Each currentFile In currentFolder.Files
        If isMatchFound(currentFile.Name, searchTerms) Then
            Cells(rowNumber, "A").Value = currentFile.Name
            rowNumber = rowNumber + 1
            fileCount = fileCount + 1
        End If
    Next currentFile
   
    If includeSubfolders Then
        For Each currentSubFolder In currentFolder.subfolders
            ProcessFolder fso, currentSubFolder, True, searchTerms, rowNumber, fileCount
        Next currentSubFolder
    End If
   
End Sub

Private Function isMatchFound(ByVal fileName As String, ByVal searchTerms As Variant) As Boolean

    Dim i As Long
   
    For i = LBound(searchTerms) To UBound(searchTerms)
        If UCase(fileName) Like "*" & UCase(searchTerms(i)) & "*" Then 'case-insensitive match
            isMatchFound = True
            Exit Function
        End If
    Next i
   
    isMatchFound = False

End Function

Hope this helps!

 

[Iceshade]

This is fantastic, can't thank you enough Dominic.

I've made a few changes, the last thing I am struggling with is adjusting this:

For Each currentFile In currentFolder.Files
        If isMatchFound(currentFile.Name, searchTerms) Then
            Cells(rowNumber, "A").Value = currentFile.Name
            rowNumber = rowNumber + 1
            fileCount = fileCount + 1
        End If
    Next currentFile

How can I also get it to provide not only the current file name but also the last modified date of current file in column B ?

Greatly appreciate this again, thank you ! (I have a lot to learn!)

 

[Domenic]

This is fantastic, can't thank you enough Dominic.

You're very welcome, glad I could help.

How can I also get it to provide not only the current file name but also the last modified date of current file in column B ?

You can use the DateLastModified property of the File object...

    For Each currentFile In currentFolder.Files
        If isMatchFound(currentFile.Name, searchTerms) Then
            Cells(rowNumber, "A").Value = currentFile.Name
            Cells(rowNumber, "B").Value = currentFile.DateLastModified
            rowNumber = rowNumber + 1
            fileCount = fileCount + 1
        End If
    Next currentFile

 

[Iceshade]

You're very welcome, glad I could help.



You can use the DateLastModified property of the File object...

    For Each currentFile In currentFolder.Files
        If isMatchFound(currentFile.Name, searchTerms) Then
            Cells(rowNumber, "A").Value = currentFile.Name
            Cells(rowNumber, "B").Value = currentFile.DateLastModified
            rowNumber = rowNumber + 1
            fileCount = fileCount + 1
        End If
    Next currentFile

Perfect, I've modified it further to give me the directory address. Exactly where I need this to be now.

Many thanks again Domenic !

 

[Domenic]

That's great, and thanks for your feedback.

Cheers!

 

[khalid_199]

Hi,
I really appreciate your effort and this code is really helpful for me.
I'm hopping if you can help me with some adjustment, i tried to make some changes but i could not.
i would like to have fixed file location where the user don't have the option every time where to search
Second i added file location (column D) to search result i would like to have icon next to each search result to open the found file.

 

[Mack_67]

@Iceshade , mind sharing your final VBA code? I have a very similar requirement but I am an absolute noob with VBA but learning as I go.