使用查找将整个页面复制到文本文档？

Question

我找到了许多将所选页面复制到新文档的宏示例，但是，我找不到任何使用查找和替换来定位单词并将包含该单词的整个页面复制到新的 Word 文档或记事本。

Sub PageGrabber()


 Dim doc As Word.Document, rng As Word.Range
    
    On Error GoTo ERRORHANDLER
    Set doc = ActiveDocument
    Set rng = doc.Content
    


   
    Set rng = doc.Content
    With rng.Find
        .Text = "help"
        .Replacement.Text = " "
        .MatchWildcards = False
        .Wrap = wdFindStop
        .Format = False
        .Forward = True
        While .Execute
        ActiveDocument.Bookmarks("\page").Range.Copy
        Documents.Open FileName:="C:\test.docx"
        Selection.Paste
        rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
        Wend
    End With
    
     
    

ERRORHANDLER:
    If Err.Number <> 0 Then
        MsgBox Err.Number & vbCr & Err.Description, vbCritical
        Err.Clear
    Else
        MsgBox "Action Complete"
    End If
    
End Sub

我试图在查找过程中使用while .execute 来抓取ActiveDocument.Bookmarks("\page").Range.Copy 对象并将其粘贴到单独的文档中，结果是复制了第一页而没有其他内容。

如果有人有示例链接或一些有用的建议来实现这一点，我们将不胜感激，谢谢。

Answer 1

例如：

Sub PageGrabber()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Set DocSrc = ActiveDocument
With DocSrc.Range
  With .Find
    .Text = "help"
    .Replacement.Text = " "
    .MatchWildcards = False
    .Wrap = wdFindStop
    .Format = False
    .Forward = True
    .Execute
  End With
  If .Find.Found = True Then
    Set DocTgt = Documents.Open(FileName:="C:\test.docx", AddToRecentFiles:=False, Visible:=False)
    DocTgt.Range.FormattedText = .Bookmarks("\page").Range.FormattedText
    DocTgt.Close True
  End If
End With
Set DocTgt = Nothing: Set DocSrc = Nothing
Application.ScreenUpdating = True
End Sub