删除除起点和终点之间的单词以外的所有内容

Question

我碰巧在尝试根据自己的喜好操作以下代码时遇到问题。 首先，下面的代码删除了我在程序中规定的开始和结束条件之间的所有内容。

我想改变这一点，删除除了开始和结束词之间规定的所有内容。

Sub SomeSub()
    Dim StartWord As String, EndWord As String
    Dim Find1stRange As Range, FindEndRange As Range
    Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'Setting up the Ranges
    Set Find1stRange = ActiveDocument.Range
    Set FindEndRange = ActiveDocument.Range
    Set DelRange = ActiveDocument.Range

    'Set your Start and End Find words here to cleanup the script
    StartWord = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |"
    EndWord = "This message has been scanned for malware by Websense. www.websense.com"

    'Starting the Find First Word
    With Find1stRange.Find
        .Text = StartWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        'Execute the Find
        Do While .Execute
            'If Found then do extra script
            If .Found = True Then
                'Setting the Found range to the DelStartRange
                Set DelStartRange = Find1stRange
                'Having these Selections during testing is benificial to test your script
                DelStartRange.Select

                'Setting the FindEndRange up for the remainder of the document form the end of the StartWord
                FindEndRange.Start = DelStartRange.End
                FindEndRange.End = ActiveDocument.Content.End

                'Having these Selections during testing is benificial to test your script
                FindEndRange.Select

                'Setting the Find to look for the End Word
                With FindEndRange.Find
                    .Text = EndWord
                    .Execute

                    'If Found then do extra script
                    If .Found = True Then
                        'Setting the Found range to the DelEndRange
                        Set DelEndRange = FindEndRange

                        'Having these Selections during testing is benificial to test your script
                        DelEndRange.Select

                    End If
                End With

                'Selecting the delete range
                DelRange.Start = DelStartRange.Start
                DelRange.End = DelEndRange.End
                'Having these Selections during testing is benificial to test your script
                DelRange.Select

                'Remove comment to actually delete
                DelRange.Delete
            End If      'Ending the If Find1stRange .Found = True
        Loop        'Ending the Do While .Execute Loop 
    End With    'Ending the Find1stRange.Find With Statement
End Sub

Answer 1

哈！那是一个新的转折当然有不止一种方法可以解决。我倾向于使用（至少）三个范围。像这样的：

Sub FindAndDeleteEverythingElse()
  Dim strFind1 As String, strFind2 As String
  Dim rngDoc As word.Range, rngFind1 As word.Range
  Dim rngFind2 As word.Range
  Dim bFound As Boolean

  strFind1 = "You"
  strFind2 = "directly."
  Set rngDoc = ActiveDocument.content
  Set rngFind1 = rngDoc.Duplicate
  Set rngFind2 = rngDoc.Duplicate
  With rngFind1.Find
    .Text = strFind1
    bFound = .Execute
  End With
  If bFound Then
    With rngFind2.Find
        .Text = strFind2
        bFound = .Execute
    End With
    If bFound Then
        rngDoc.End = rngFind1.Start
        rngDoc.Delete
        rngDoc.Start = rngFind2.End
        rngDoc.End = ActiveDocument.content.End
        rngDoc.Delete
    End If
  End If
End Sub

“主要”范围是整个文档的范围：ActiveDocument.Content。 Range 对象与其他对象有点不同，如果将一个 Range 设置为另一个 Range，它将成为该 Range，而不是副本。所以你需要Duplicate 方法来复制一个范围。这使您可以将Find 独立用于各种范围。

如果第一次查找成功，则执行第二次。如果这也成功，则将文档范围的终点设置为成功查找的起点，并删除范围的内容。然后将 Document Range 重新定义为从找到的第二个 Range 的端点开始，并在 Document 的末尾结束，然后将其删除。

与我在这段代码 sn-p 中所做的相比，您可能需要设置更多 Range.Find 属性 - 我使用了绝对最小值来更清晰地使用 Ranges。

Answer 2

也许还有另一种方法，但在那之前你可以做到这一点。 尝试像这样在字符串之后和之前添加虚拟字符

With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchWildcards = False
      .Text = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |"
      .Replacement.Text = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |######"
      .Execute Replace:=wdReplaceAll
      .Text = "This message has been scanned for malware by Websense. www.websense.com"
      .Replacement.Text = "@@@@@@This message has been scanned for malware by Websense. www.websense.com"
      .Execute Replace:=wdReplaceAll
    End With
End With
End Sub

然后尝试在######和@@@@@@之间设置范围

这是设置范围select a range of text from one Word document and copy into another Word document的最佳答案

请注意，在 my word 2007 中，无法在超链接中找到。在替换之前尝试删除所有超链接或范围内的超链接。 另一个最佳答案：How do you remove hyperlinks from a Microsoft Word document?