vba - 从一个Word文档中选择一系列文本，然后复制到另一个Word文档中

Question

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

搜索“标题”
在“标题”之后执行(取)每个字符，然后(停止)直到“地址”

Answer 1

可以进行以下工作，但是可能有更有效的方法:

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

您可以使用“激活”(最好使用对象变量)在文档之间进行切换。

微软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