从一个 Word 文档中选择一系列文本并复制到另一个 Word 文档中

我正在尝试使用VBA提取一个Word文档中的句子并将其放入另一个Word文档中。 例如，如果我们需要查找组织的头衔，我们遵循以下算法：

搜索“标题”
执行（获取）“标题”之后的每个字符并（停止）直到“地址”

以下方法有效，但可能有更有效的方法：

Sub FindIt()
    Dim blnFound As Boolean
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rngFound As Range
    Dim strTheText As String

    Application.ScreenUpdating = False
    Selection.HomeKey wdStory
    Selection.Find.Text = "Title"
    blnFound = Selection.Find.Execute
    If blnFound Then
        Selection.MoveRight wdWord
        Set rng1 = Selection.Range
        Selection.Find.Text = "Address"
        blnFound = Selection.Find.Execute
        If blnFound Then
            Set rng2 = Selection.Range
            Set rngFound = ActiveDocument.Range(rng1.Start, rng2.Start)
            strTheText = rngFound.Text
            MsgBox strTheText
        End If
    End If
    'move back to beginning
    Selection.HomeKey wdStory
    Application.ScreenUpdating = True
End Sub

您可以使用Activate 在文档之间进行切换，最好使用对象变量。

Microsoft MVP Jay Freedman 善意地为我修改了这一点，让我可以在没有 Selection 对象的情况下工作，使其更加整洁。

Sub RevisedFindIt()
' Purpose: display the text between (but not including)
' the words "Title" and "Address" if they both appear.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim strTheText As String

    Set rng1 = ActiveDocument.Range
    If rng1.Find.Execute(FindText:="Title") Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Find.Execute(FindText:="Address") Then
            strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text
            MsgBox strTheText
        End If
    End If
End Sub

唯一剩下的要求是将此文本放入其他文档中。就像是：

Documents(2).Range.Text = strTheText