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

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

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中但是尝试引用Word Range对象，您需要限定变量声明，以便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

祝你好运。

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

4 个答案: