Find a phrase in Word and Adobe files

I just got an idea to make a little searcher, I mean the tool to search through and find a word, or whole phrase, in Word or Adobe files.

Let’s imagine the situation: You’ve got folder with procedures. Lot’s of procedures. Some of them are Word file (.doc, .docx etc.) and some of them in Adobe Acrobat Reader (.pdf). You want to find procedure, which is about something, but don’t really remember which one was it. The only thing You remember is that, for sure, there were some specific words. So… lets get started!

Code description

First of all I will introduce You into my worksheet structure: Sheet1 with 2 columns. In first column put the words to search for and second column (“B”) for results.

Then we need to write a code, which allow us to choose folder to dig in:

Set o_file_dialog = Application.FileDialog(msoFileDialogFolderPicker)
With o_file_dialog
    .AllowMultiSelect = False
    .Title = "Choose your folder"
    If .Show = True Then
        s_item_path = .SelectedItems(1)
    End If
End With

Don’t forget to set Microsoft Scripting Runtime reference for that! (Tools/References/ Microsoft Scripting Runtime)

Set MyFSO = New Scripting.FileSystemObject
Set MyFolder = MyFSO.GetFolder(s_item_path)

Next we set variable MyFolder with chosen folder and then we go with looping through files in MyFolder, checking if are they Word / Adobe file.

With ThisWorkbook.Sheets("Sheet1")

    fraza = .Range("A2")
    
    For Each MyFile In MyFolder.Files
        
        If MyFile.Type = "Microsoft Word Document" Or InStr(1, _
MyFile.Type, "Word") Or InStr(1, MyFile.Type, "Adobe") Then

Also, we need to add conditional function for ~files. These are temporary files/icons, which appears in folder after opening file and sometimes they don’t want to disappear as fast as closing file. We need to miss them and not to try open.

            If InStr(1, MyFile.Name, "~") Then
                'we do nothing :)
            Else

After that, main thing of the case:
– set Word Application – we are using it for both Word and Adobe files
– open file and set content of the file to variable
– checking if our seeking phrase is in the content.
If yes, code should write down name of MyFile and make link to the file in folder. If not, go to next file 🙂

                Set WordApp = CreateObject("Word.Application")
                'WordApp.visible = false
                Application.DisplayAlerts = False
                Set WordDoc = WordApp.documents.Open(MyFile.Path)
                Application.DisplayAlerts = True
                'MyFile.OpenAsTextStream
                Set zakres = WordDoc.Content
                
                If InStr(1, zakres, fraza) Then
                    lastRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
                    .Range("B" & lastRow) = MyFile.Name
                    .Hyperlinks.Add Anchor:=.Range("B" & lastRow), _
Address:=MyFile.Path, TextToDisplay:=MyFile.Name
                End If
                
                Set zakres = Nothing
                WordDoc.Close 0
                WordApp.Quit
            End If
        End If

I hope it will be useful for someone. If You got any suggestion to code, feel free to comment. I really appreciate every feedback 🙂

Whole code:

Option Explicit

Sub seekInFiles()

Dim MyFSO As FileSystemObject
Dim s_item_path As String
Dim o_file_dialog As FileDialog
Dim MyFile As File
Dim MyFolder As Folder
Dim WordApp As Object
Dim WordDoc As Object
Dim zakres As Variant
Dim fraza As String
Dim lastRow As Long

Application.ScreenUpdating = False

Set o_file_dialog = Application.FileDialog(msoFileDialogFolderPicker)
With o_file_dialog
    .AllowMultiSelect = False
    .Title = "Choose your folder"
    If .Show = True Then
        s_item_path = .SelectedItems(1)
    End If
End With

Set MyFSO = New Scripting.FileSystemObject
Set MyFolder = MyFSO.GetFolder(s_item_path)

With ThisWorkbook.Sheets("Sheet1")

    fraza = .Range("A2")
    
    For Each MyFile In MyFolder.Files
        
        If MyFile.Type = "Microsoft Word Document" Or InStr(1, _
MyFile.Type, "Word") Or InStr(1, MyFile.Type, "Adobe") Then
            If InStr(1, MyFile.Name, "~") Then
                'we do nothing :)
            Else
                Set WordApp = CreateObject("Word.Application")
                'WordApp.visible = false
                Application.DisplayAlerts = False
                Set WordDoc = WordApp.documents.Open(MyFile.Path)
                Application.DisplayAlerts = True
                'MyFile.OpenAsTextStream
                Set zakres = WordDoc.Content
                
                If InStr(1, zakres, fraza) Then
                    lastRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
                    .Range("B" & lastRow) = MyFile.Name
                    .Hyperlinks.Add Anchor:=.Range("B" & lastRow), _
Address:=MyFile.Path, TextToDisplay:=MyFile.Name
                End If
                
                Set zakres = Nothing
                WordDoc.Close 0
                WordApp.Quit
            End If
        End If
        
    Next
    
End With

MsgBox "Done"

Application.ScreenUpdating = True

End Sub