Searching for Text in Header Section of A Word Document

后端 未结 2 490
南笙
南笙 2020-12-21 15:18

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 thou

相关标签:
2条回答
  • 2020-12-21 15:42

    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
    
    0 讨论(0)
  • 2020-12-21 15:48

    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

    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
    
    0 讨论(0)
提交回复
热议问题