vba code to search for a text file in all the folders and sub folders

Question

Can anyone please help me with a vba code that would search for a user input keyword inside a text file in all the folders and sub folders of a shared drive. And, if the keyword is found in the text file, it should return the folder name and path that contains the text file.

I have a windows form, wherein users can input a keyword and when the user hit the search button, it has to perform the above function.

For example: If a user search for a keyword like "Business", it should look in the for "Business" in all of the text files in all of the folders and sub folders in the shared drive. And if it is found, it should return the folder name and its path containing the file. Example of output

Folder name: ABC Folder path: C:\office\ABC

Can anyone please help me with the code Thanking you in advance.

Here is my code

enter code here

Public Sub FindFiles()

'Added reference to 'Microsoft Shell Controls And Automation'

Dim shl As Shell32.Shell

Dim fol As Shell32.Folder

Dim row As Long

Set shl = New Shell32.Shell

Set fol = shl.Namespace("C:\Users\")

row = 1

ProcessFolderRecursively fol, row

End Sub

Private Sub ProcessFolderRecursively(fol As Shell32.Folder, ByRef row As Long)

Dim item As Shell32.FolderItem

Dim fol2 As Shell32.Folder

If Not fol Is Nothing Then

For Each item In fol.Items

    If item.IsFolder Then

        Set fol2 = item.GetFolder

        ProcessFolderRecursively fol2, row

    Else

       Sheets("Sheet2").Select

            Cells(row, 1) = item.path

            row = row + 1  
    End If

Next

End If

End Sub

Answer 1

i believe this answer will help you to answer your question.

Using a wildcard to open an excel workbook

In VBA you can not wildcard characters like * to open files. If the file names and locations do not change then you need to compile a list of all the file names.

You can then take the list, open each file in the list and scan the text doc with a find() function for the searched key word. if found then return the file name.

the issue you face is compiling the file locations to make the list, which i dont have an answer. the rest is easy.

Answer 2

The following code could help you

Option Explicit
Public Function RecursiveDir(colFiles As Collection, _
                             strFolder As String, _
                             strFileSpec As String, _
                             bIncludeSubfolders As Boolean)

Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colFiles.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop

        'Call RecursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If

End Function

Public Function TrailingSlash(strFolder As String) As String
    If Len(strFolder) > 0 Then
        If Right(strFolder, 1) = "\" Then
            TrailingSlash = strFolder
        Else
            TrailingSlash = strFolder & "\"
        End If
    End If
End Function

Function SearchTxtFile(ByVal txtFileName As String, txtSearch As String) As Boolean

Dim fso As Object 'Scripting.FileSystemObject
Dim myFile As Object 'Scripting.TextStream     
Dim ReadAllTextFile As Variant

    Set fso = CreateObject("Scripting.FileSystemObject")
    ' Open the file for input.
    Set myFile = fso.OpenTextFile(txtFileName, ForReading)

    ' Read from the file.
    If myFile.AtEndOfStream Then
        ReadAllTextFile = ""
    Else
        ReadAllTextFile = myFile.ReadAll
    End If

    If InStr(1, ReadAllTextFile, txtSearch, vbTextCompare) > 0 Then
        SearchTxtFile = True
    Else
        SearchTxtFile = False
    End If

End Function
Sub TestSearchFiles()

Dim colFiles As New Collection
Const txtPattern = "Business"
Const YOUR_START_DIR = "Your Dir"

    RecursiveDir colFiles, YOUR_START_DIR, "*.TXT", True

    Dim vFile As Variant
    For Each vFile In colFiles
        If SearchTxtFile(vFile, txtPattern) Then
            Debug.Print vFile
        End If
    Next vFile

End Sub

EDIT The following code will give the path name of a full path

Function GetDirectory(path)
   GetDirectory = Left(path, InStrRev(path, "\"))
End Function

Chhange the debug.print line in the code above to

Debug.Print vFile, GetDirectory(vFile)

Is that what you want?

EDIT2: Change the search function like that

Function SearchTxtFile(ByVal txtFileName As String, txtSearch() As Variant) As Boolean

Dim fso As Object    'Scripting.FileSystemObject
Dim myFile As Object    'Scripting.TextStream
Dim ReadAllTextFile As Variant
Dim i As Long

    Set fso = CreateObject("Scripting.FileSystemObject")
    ' Open the file for input.
    Set myFile = fso.OpenTextFile(txtFileName, ForReading)

    ' Read from the file.
    If myFile.AtEndOfStream Then
        ReadAllTextFile = ""
    Else
        ReadAllTextFile = myFile.ReadAll
    End If

    For i = LBound(txtSearch) To UBound(txtSearch)
        If InStr(1, ReadAllTextFile, txtSearch(i), vbTextCompare) > 0 Then
            SearchTxtFile = True
        Else
            SearchTxtFile = False
            ' If just one string is not found
            ' no further search neccessary
            Exit Function
        End If
    Next

End Function

Test it with

Sub TestSearchFiles()

Dim colFiles As New Collection
Dim txtPattern() As Variant
Const YOUR_START_DIR = "Your directory here"

    txtPattern = Array("Pattern1", "Pattern2")
    RecursiveDir colFiles, YOUR_START_DIR, "*.TXT", True

    Dim vFile As Variant
    For Each vFile In colFiles
        If SearchTxtFile(vFile, txtPattern) Then
            Debug.Print vFile, GetDirectory(vFile)
        End If
    Next vFile

End Sub