vba 在 Word 文档的标题部分中搜索文本

Searching for Text in Header Section of A Word Document

提问by Matt Rowles

I am trying to confirm if a document contains some text, the only problem is this text is in the Header. This is the code I am using which constantly returns false even though the text exists:

我想确认一个文档是否包含一些文本，唯一的问题是这个文本在标题中。这是我正在使用的代码，即使文本存在，它也会不断返回 false：

Set CurrentDoc = Documents.Open("a.doc")

With CurrentDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Find
    .Text = "This is the text to find"
    .Forward = True
    .Execute
    If (.Found = True) Then Debug.Print "Match"
End With

The following also doesn't seem to work (I assume .Contentdoesn't include header/footers):

以下似乎也不起作用（我假设.Content不包括页眉/页脚）：

With CurrentDoc.Content.Find
    .Text = "This is the text to find"
    .Forward = True
    .Execute
    If (.Found = True) Then Debug.Print "Match"
End With

Any help would be greatly appreciated.

任何帮助将不胜感激。

采纳答案by Matt Rowles

I found the answer on this site and it's a lot more complex than initially thought: http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm

我在这个网站上找到了答案，它比最初想象的要复杂得多：http: //word.mvps.org/faqs/customization/ReplaceAnywhere.htm

The following code is from the site above, in addition to searching the entire document it includes text replace functionality:

以下代码来自上面的站点，除了搜索整个文档外，它还包括文本替换功能：

Public Sub FindReplaceAnywhere()
    Dim rngStory As Word.Range
    Dim pFindTxt As String
    Dim pReplaceTxt As String
    Dim lngJunk As Long
    Dim oShp As Shape

    pFindTxt = InputBox("Enter the text that you want to find.", "FIND" )

    If pFindTxt = "" Then
        MsgBox "Cancelled by User"
        Exit Sub
    End If

    TryAgain:
        pReplaceTxt = InputBox( "Enter the replacement." , "REPLACE" )

        If pReplaceTxt = "" Then
            If MsgBox( "Do you just want to delete the found text?", vbYesNoCancel) = vbNo Then
                GoTo TryAgain
            ElseIf vbCancel Then
                MsgBox "Cancelled by User."
            Exit Sub
        End If
    End If

    'Fix the skipped blank Header/Footer problem
    lngJunk = ActiveDocument.Sections( 1 ).Headers( 1 ).Range.StoryType

    'Iterate through all story types in the current document
    For Each rngStory In ActiveDocument.StoryRanges

        'Iterate through all linked stories
        Do
            SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
            On Error Resume Next
            Select Case rngStory.StoryType
                Case WdStoryType.wdEvenPagesHeaderStory, _
                     WdStoryType.wdPrimaryHeaderStory, _
                     WdStoryType.wdEvenPagesFooterStory, _
                     WdStoryType.wdPrimaryFooterStory, _
                     WdStoryType.wdFirstPageHeaderStory, _
                     WdStoryType.wdFirstPageFooterStory
                    If rngStory.ShapeRange.Count > 0 Then
                        For Each oShp In rngStory.ShapeRange
                            If oShp.TextFrame.HasText Then
                                SearchAndReplaceInStory oShp.TextFrame.TextRange, pFindTxt, pReplaceTxt
                            End If
                        Next
                    End If
                Case Else
                    'Do Nothing
                End Select
                On Error GoTo 0

                'Get next linked story (if any)
                Set rngStory = rngStory.NextStoryRange
            Loop Until rngStory Is Nothing
        Next
End Sub

Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, ByVal strSearch As String , ByVal strReplace As String)
    With rngStory.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = strSearch
        .Replacement.Text = strReplace
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With
End Sub

回答by SouthL

You're probably trying to search in the wrong section/headertype. You could try this code:

您可能正在尝试在错误的部分/标题类型中进行搜索。你可以试试这个代码：

Dim rng As Range
Dim intSecCount As Integer
Dim intHFType As Integer
intSecCount = ActiveDocument.Sections.Count
For intSection = 1 To intSecCount
    With ActiveDocument.Sections(intSection)
        For intHFType = 1 To 3 
            Set rng = ActiveDocument.Sections(intSection).Headers(intHFType).Range
            rng.Find.Execute findtext:="This is the text to find", Forward:=True
            If rng.Find.Found = True Then
                Debug.Print "Match" 
            End If
        Next intHFType
    End With
Next intSection