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

Question

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 found.

My problem is that currently it only searches the first page as the document is opened, but there are about 400 pages per document that needs searching.

Private Sub CommandButton1_Click()
    Dim i As Integer
    i = 2
    Do While Cells(i, 1).Value <> ""
        Set wdApp = CreateObject("Word.Application")
        wdApp.Visible = True
        wdApp.documents.Open ("\\Location" & Cells(i, 9) & ".docx")

        Dim Sctn As Section, HdFt As HeadersFooters
        Dim FindWord As String
        FindWord = Cells(i, 11).Value

        wdApp.Selection.WholeStory
        wdApp.Selection.Find.ClearFormatting

        For Each Sctn In wdApp.ActiveDocument.Sections
            For Each HdFt In Sctn.Headers(wdHeaderFooterPrimary)
                With wdApp.Selection.Find          
                    .Text = FindWord
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = True
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False

                    If .Execute Then
                        Cells(i, 12).Value = "Yes"
                    Else
                        Cells(i, 12).Value = "No"
                    End If
                End With
            Next
        Next
        wdApp.Quit

        i = i + 1
    Loop
End Sub

I currently have it telling me 'yes' or 'no' for whether the data has been located, to save on printing.

I would be extremely grateful for any help you are able to provide, or pointers.

Answer 1

Your code's inefficiency largely stems from the unnecessary repeated creation & destruction of Word sessions. You're also using named Word constants, which is inconsistent with the late binding implied by CreateObject("Word.Application"). Another thing you need to be aware of (as Cindy pointed out) is that Sections, rather than pages, have headers. Additionally, headers can be linked to those in previous Sections, in which case they don't need individual testing. Since you're trying to find content that could be in any Section's primary header, it's better to use the StoryRanges Collection. Try:

Private Sub CommandButton1_Click()
Dim ObjWrd As Object, ObjDoc As Object, ObjSctn As Object, ObjHdFt As Object
Dim xlWkSht As Worksheet, r As Long
Set xlWkSht = activesheet: i = 2
Set ObjWrd = CreateObject("Word.Application")
With ObjWrd
  .Visible = True
  Do While xlWkSht.Cells(r, 1).Value <> ""
    Set ObjDoc = wdApp.Documents.Open("\\Location" & Cells(i, 9) & ".docx", False, True, False)
    With ObjDoc
      With .StoryRanges(7).Find '7 = wdPrimaryHeaderStory
        .ClearFormatting
        .Text = Cells(i, 11).Value
        .Forward = True
        .Wrap = 0 '0 = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
        If .Found = True Then
          xlWkSht.Cells(r, 12).Value = "Yes"
        Else
          xlWkShtCells(r, 12).Value = "No"
        End If
      End With
      .Close False
    End With
    r = r + 1
  Loop
  .Quit
End With
End Sub

The other thing to be aware of is that Word documents have three headers & footers per Section (Even Pages, First Page and Primary). The above code only searches the Primary header. If you want to search the others as well, you need code like:

Private Sub CommandButton1_Click()
Dim ObjWrd As Object, ObjDoc As Object, ObjSctn As Object, ObjHdFt As Object
Dim xlWkSht As Worksheet, r As Long, i As Long
Set xlWkSht = activesheet: i = 2
Set ObjWrd = CreateObject("Word.Application")
With ObjWrd
  .Visible = True
  Do While xlWkSht.Cells(r, 1).Value <> ""
    xlWkShtCells(r, 12).Value = "No"
    Set ObjDoc = wdApp.Documents.Open("\\Location" & Cells(i, 9) & ".docx", False, True, False)
    With ObjDoc
      For i = 6 To 10
        Select Case i
          Case 6, 7, 10 '6 = wdEvenPagesHeaderStory, 7 = wdPrimaryHeaderStory, 10 = wdFirstPageHeaderStory
            With .StoryRanges(i).Find
              .ClearFormatting
              .Text = Cells(i, 11).Value
              .Forward = True
              .Wrap = 0 '0 = wdFindStop
              .Format = False
              .MatchCase = False
              .MatchWholeWord = True
              .MatchWildcards = False
              .MatchSoundsLike = False
              .MatchAllWordForms = False
              .Execute
              If .Found = True Then
                xlWkSht.Cells(r, 12).Value = "Yes"
                Exit For
              End If
            End With
          Case Else 'Do nothing
        End Select
      .Close False
    End With
    r = r + 1
  Loop
  .Quit
End With
End Sub