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

【问题标题】：select a range of text from one Word document and copy into another Word document从一个 Word 文档中选择一系列文本并复制到另一个 Word 文档中
【发布时间】：2020-07-05 20:06:59
【问题描述】：

我正在尝试使用 VBA 在一个 Word 文档中提取句子并将其放入另一个 Word 文档中。所以举个例子，如果我们需要找到组织的名称，我们就按照算法：

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

【问题讨论】：

标签： vba ms-word

【解决方案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

您可以使用 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

【讨论】：

对不起，不，我认为这要求太多了。（也许其他人会自愿。）我认为如果您阅读或单步执行该代码，则该代码相当清晰。此外，我不确定我会添加什么注释！单击一个单词并按 F1 功能键以查看它的帮助页面。
谢谢！是的。收到！但是，如何将此文本放入其他文档中？我尝试了你提到的方式，但我不确定它是如何工作的。我对VB不熟悉。非常感谢您的帮助！

【解决方案2】：

此代码将写入外部文件：

Sub RevisedFindIt_savetofile2 () 
' Purpose: display the text between (but not including)
' the words "Title" and "Address" if they both appear.
'This file will search current document only, the data in open word document.
Dim rng1 As Range
Dim rng2 As Range
Dim strTheText As String
Dim DestFileNum As Long
Dim sDestFile As String

sDestFile = "C:\test-folder\f12.txt" 'Location of external file
DestFileNum = FreeFile()
'A valid file number in the range 1 to 511,
'inclusive. Use the FreeFile function to obtain the next available file number.

Open sDestFile For Output As DestFileNum 'This opens new file with name DestFileNum
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 'writes string to a message box
        Print #DestFileNum, strTheText 'Print # will write to external file with the text strTheText
    End If
End If
Close #DestFileNum 'Close the destination file
End Sub

【讨论】：

【解决方案3】：

Excel 和 Word 都有一个 Range 对象。因为您在 Excel VBA 中但试图引用 Word Range 对象，所以您需要限定变量声明，以便 Excel 知道您使用的是 Word Range 对象。

Dim rng1 As Word.Range
Dim rng2 As Word.Range

感谢 ChipsLetten 发现这一点

【讨论】：

【解决方案4】：

您可以（最好）使用其他文档的名称，而不是索引 (2)：

Documents("OtherName").Range.Text = strTheText

但是，这会更改整个文档的文本，因此您需要导航到要插入文本的位置。

如果可能，最好在文档（或模板）中有预先存在的书签供您参考：

Documents("OtherName").Bookmarks("bkSome").Range.Text = strTheText

祝你好运。

【讨论】：