Search string in First Page Header of Word docs in Folder (sub folders)

[Sleeplol]

Hi,
I'm hoping for help modifying the below (or possibly scrap) script.

Routine:
Return all MS Word File Names from a folder (sub folders would be even better) that contain a string in the First Page Header.

For instance the user would like all files that pertain to "Pellet Tech". So, she adds the folder path to cell Worksheets("Data").Range("I1") and adds the string ("Pellet Tech") to Worksheets("Data").Range("J1")
The Front Header is the below which notes "Pellet Tech" in the Apply to:

This script only returns all the file names from a particular folder regardless of extension:

Sub LoopThroughFiles()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.getfolder(Worksheets("Data").Range("I1"))

For Each oFile In oFolder.Files

    Worksheets("Data").Cells(i + 1, 1) = oFile.Name

    i = i + 1

Next oFile

End Sub

Thanks for any help with this

 

[NdNoviceHlp]

Hi sleeplol. You can trial this untested code which seems like it might work. HTH. Dave

Sub LoopThroughFiles()
Dim oFSO As Object, oHF As Object
Dim oFolder As Object, WordApp as Object
Dim oFile As Object
Dim i As Integer

'create Word app
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WordApp.Visible = False


Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(Worksheets("Data").Range("I1"))

For Each oFile In oFolder.Files
If oFile.Name Like "*" & ".doc" & "*" Then
WordApp.Documents.Open (oFile)
Set oHF = WordApp.ActiveDocument.Sections(1).Headers(1)
If InStr(oHF.Range.Text, CStr(Worksheets("Data").Range("J1"))) Then
    Worksheets("Data").Cells(i + 1, 1) = oFile.Name
    i = i + 1
WordApp.ActiveDocument.Close SaveChanges:=False
End If
End If
Next oFile

WdApp.Quit
Set WdApp = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
End Sub

 

[Sleeplol]

Hi NdNoviceHlp,
Thanks for working out this script.
On first run I get a run time

for

Then after selecting debug and resetting it then opens ALL of the Word documents in the designated folder.

 

[NdNoviceHlp]

Spelling/copy&paste error. It should be...

WordApp.Quit
Set WordApp = Nothing

You may need to check your task manger and make sure there are no instances of Word running. If there is a Word process running (without any doc open) then select the process and End it. Dave

 

[Sleeplol]

Ok, I ended all Word tasks.
Ran the script; same error.
Task Manager then showed Microsoft Word (5)

Ended those tasks

Then, I stepped through the code and saw that it loops 5 times (makes sense since I put 5 documents in a test folder) before the WdApp.Quit error.

 

[Sleeplol]

Dave,
I've poked around and made some minor changes, but I'm still not getting anything returned;

Sub LoopThroughFiles2()
    Dim oFSO As Object, oHF As Object
    Dim oFolder As Object, WordApp As Object
    Dim oFile As Object
    Dim i As Integer
    
    'initialize i to 1
    i = 1
    
    'create Word app
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set WordApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    WordApp.Visible = False
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(Worksheets("Data").Range("I1"))
    
    For Each oFile In oFolder.Files
        If oFile.Name Like "*" & ".doc" & "*" Then
            WordApp.Documents.Open (oFile)
            Set oHF = WordApp.ActiveDocument.Sections(1).Headers(1)
            If InStr(oHF.Range.Text, CStr(Worksheets("Data").Range("J1"))) Then
                Worksheets("Data").Cells(i + 1, 1) = oFile.Name
                i = i + 1
            End If
            WordApp.ActiveDocument.Close SaveChanges:=False
        End If
    Next oFile
    
    WordApp.Quit
    Set WordApp = Nothing
    Set oFolder = Nothing
    Set oFSO = Nothing
End Sub

 

[Sleeplol]

I have also tried this, but to no avail:

I'm at a total loss; both scripts are executing and looping through the Word docs, but nothing is returned. I've manually put the desired string "Pellet" in multiple Front Page Headers so I know there is something to return.

Would you (or anyone else) be willing to spitball some ideas?

Sub SearchWordDocs()
    Dim objWord As Object ' Word.Application
    Dim objDoc As Object ' Word.Document
    Dim objRange As Object ' Word.Range
    Dim strSearch As String
    Dim strFolderPath As String
    Dim strFileName As String
    Dim strFilePath As String
    Dim intRow As Integer
    
    ' Get the search string and folder path from the Info worksheet
    strSearch = Worksheets("Data").Range("J1").Value
    strFolderPath = Worksheets("Data").Range("I1").Value
    
    ' Display the folder path and search string in a message box
    MsgBox "Folder path: " & strFolderPath & vbCrLf & "Search string: " & strSearch
    
    ' Initialize the Word application
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = False ' Set to true if you want to see the Word documents being searched
    
    ' Loop through all files in the specified folder and its subfolders
    RecursiveFolderSearch objWord, strSearch, strFolderPath
    
    ' Close the Word application
    objWord.Quit
    Set objWord = Nothing
End Sub

Sub RecursiveFolderSearch(objWord As Object, strSearch As String, strFolderPath As String)
    Dim objFSO As Object ' Scripting.FileSystemObject
    Dim objFolder As Object ' Scripting.Folder
    Dim objFile As Object ' Scripting.File
    Dim strFilePath As String
    Dim intRow As Integer
    Dim objDoc As Object ' Word.Document
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strFolderPath)
    
    ' Loop through all files in the folder
    For Each objFile In objFolder.Files
        If LCase(Right(objFile.Name, 4)) Like ".doc*" Then ' Check if the file is a Word document
            ' Open the Word document
            strFilePath = objFile.Path
            Set objDoc = objWord.Documents.Open(strFilePath)
            
            ' Search the front page header of the document for the search string
            With objDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range
                With .Find
                    .Text = strSearch
                    .MatchCase = False
                    .MatchWholeWord = False
                    If .Execute Then
                        ' If the search string is found, add the file path to the Data worksheet
                        intRow = Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Row + 1
                        Worksheets("Data").Range("A" & intRow).Value = strFilePath
                    End If
                End With
            End With
            
            ' Close the Word document
            objDoc.Close False 
        End If
    Next objFile
    
    ' Recursively search all subfolders
    For Each objFolder In objFolder.SubFolders
        RecursiveFolderSearch objWord, strSearch, objFolder.Path
    Next objFolder
End Sub

 

[NdNoviceHlp]

Searching EVERY header in a Word document, using Excel VBA?

So I have the (incredibly ugly) code below, which I need to use to open a specified word document, search for a certain value in the header of every page, and then print the page on which it is fou...

stackoverflow.com

Interesting stuff re. sections and headers at this link. Seems like you need to search the story ranges. I think there's a code solution at this link for U at this link as well. Dave
edit: ps. there should only be 1 instance of Word running. All documents should be opened and closed using the 1 instance

 

[Sleeplol]

Alrighty,
Dave, first off, thanks for sticking with me and sharing advice.
Turns out your code works on "Header" just not "First Page Header"
So, if this top little guy "Different First Page" isn't checked then it works perfectly

 

[Sleeplol]

Also, is there a way to have this search subfolders of the desired folder???