Question

对于我的工作，我制定了产品规格。我有一个包含所有数据的表，以及需要插入数据的标准Word文档。我使用Word中的内置邮件合并功能执行此操作。但是，我需要单独保存文档，我找到了以下代码：

Sub BreakOnSection()
   ' Used to set criteria for moving through the document by section.
   Application.Browser.Target = wdBrowseSection

   'A mailmerge document ends with a section break next page.
   'Subtracting one from the section count stop error message.
   For i = 1 To ((ActiveDocument.Sections.Count) - 1)

      'Select and copy the section text to the clipboard
      ActiveDocument.Bookmarks("\Section").Range.Copy

      'Create a new document to paste text from clipboard.
      Documents.Add
      Selection.Paste

   ' Removes the break that is copied at the end of the section, if any.
      Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
      Selection.Delete Unit:=wdCharacter, Count:=1

     ChangeFileOpenDirectory "C:\"
      DocNum = DocNum + 1
     ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
     ActiveDocument.Close
      ' Move the selection to the next section in the document
     Application.Browser.Next
   Next i
   ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

这将文档保存为测试1，测试2等

我想使用我用于邮件合并的其中一个数据项来保存文档。有没有办法做到这一点？

Answer 1

我做到了，这是我现在的代码

Sub BreakOnSection()
   ' Used to set criteria for moving through the document by section.
   Application.Browser.Target = wdBrowseSection

   'A mailmerge document ends with a section break next page.
   'Subtracting one from the section count stop error message.
   For i = 1 To ((ActiveDocument.Sections.Count) - 1)

      'Select and copy the section text to the clipboard
      ActiveDocument.Bookmarks("\Section").Range.Copy

      'Create a new document to paste text from clipboard.
      Documents.Add
      Selection.Paste

      Dim rngParagraphs As Range
      Set rngParagraphs = ActiveDocument.Range(Start:=(ActiveDocument.Paragraphs(1).Range.Start + 6), End:=(ActiveDocument.Paragraphs(1).Range.End - 1))
      rngParagraphs.Select

   ' Removes the break that is copied at the end of the section, if any.
      Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
      Selection.Delete Unit:=wdCharacter, Count:=1

     ChangeFileOpenDirectory "C:\"
      DocNum = DocNum + 1
     ActiveDocument.SaveAs FileName:="Productspec" & rngParagraphs & ".doc"
     ActiveDocument.Close
      ' Move the selection to the next section in the document
     Application.Browser.Next
   Next i
   ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

使用邮件合并中的数据保存文档

1 个答案: