Word VBA 重復查找和替換帶跟蹤

Question

我正在嘗試在類似字符串上使用查找和替換來運行 Word VBA 宏。 它可以完美地與跟蹤關閉，但在跟蹤時，我會得到像 CompanyCompany 這樣的重復。 似乎僅在打開跟蹤時才同時執行查找/替換。 我有數百個文件到 go 通過所以跟蹤是必須的。 關於如何避免這種情況的任何建議？

Private Sub document_open()

With ActiveDocument 
 .TrackRevisions = True 
 .ShowRevisions = True 
End With

Dim rngStory As Word.Range
Dim lngValidate As Long
  lngValidate = 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 While .Found = True        
      With rngStory.Find

        .ClearFormatting
        .IgnoreSpace = True
        .MatchCase = False
        .Text = "Corporation"
        .Replacement.ClearFormatting
        .Replacement.Text = "Company"
        .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
        
        .ClearFormatting
        .IgnoreSpace = True
        .MatchCase = False
        .Text = "Corp."
        .Replacement.ClearFormatting
        .Replacement.Text = "Company"
        .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
        
        .ClearFormatting
        .IgnoreSpace = True
        .MatchCase = False
        .Text = "Corp"
        .Replacement.ClearFormatting
        .Replacement.Text = "Company"
        .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue

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

End Sub

Answer 1

以下應該工作

Private Sub document_open()

With ActiveDocument
    .TrackRevisions = True
    .ShowRevisions = True
End With

Dim story As Range

For Each story In ActiveDocument.storyRanges
    Do While Not story Is Nothing
        With story.Find
            .Replacement.text = "Company"
            .Execute "Corporation", Replace:=wdReplaceAll
            .Execute "Corp.", Replace:=wdReplaceAll
            .Execute "Corp", Replace:=wdReplaceAll
        End With
        
        Set story = story.NextStoryRange
    Loop
Next

End Sub