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

Question

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

搜索“Title”在“Title”
之后执行（Take）每个字符并（停止）直到“Address”

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

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

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

Answer 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

Answer 3

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

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

感谢 ChipsLetten 发现这一点

Answer 4

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

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

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

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

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

祝你好运。