丢失格式与MS Word Mailmerge Macro

Question

使用

MS Word 2010 我希望 Mailmerge 使用宏运行，将每条记录保存为单独的文件，以 PDF 格式使用其中一个字段作为文件名。 这将为我节省大量时间。

我遇到的问题是格式完全丢失了，就好像它只是复制文本并将其粘贴到新文档中一样。有什么方法可以保护格式，因为没有它，它是毫无结果的......

提前谢谢。

Sub splitter()
Dim i As Integer
Dim Source As Document
Dim Target As Document
Dim Letter As Range
Dim oField As Field
Dim FileNum As String
Set Source = ActiveDocument
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
For i = 1 To ActiveDocument.MailMerge.DataSource.ActiveRecord
    ActiveDocument.MailMerge.DataSource.ActiveRecord = i
    Set Letter = Source.Range
        For Each oField In Letter.Fields
        If oField.Type = wdFieldMergeField Then
            If InStr(oField.Code.Text, "INV_ID") > 0 Then
            FileNum = oField.Result
            End If
        End If
        Next oField
    Set Target = Documents.Add
    Target.Range = Letter
    Target.SaveAs2 "C:BACSINVOICINGINVOICESWord Export" & FileNum, 17
    Target.Close
    Next i
End Sub

Answer 1

使用保存怎么样？

此示例代码循环遍历邮件合并文档中的每个 mailmerge 项，以字母形式打开该项，并使用数据源中的字段作为文件名将其保存到 PDF。没有错误编码，也没有尝试检查重复的文件名。这是一个片段。

Dim iRec As Integer
Dim docMail As Document
Dim docLetters As Document

Set docMail = ActiveDocument
''There is a problem with the recordcount property returning -1
''http://msdn.microsoft.com/en-us/library/office/ff838901.aspx
docMail.MailMerge.DataSource.ActiveRecord = wdLastRecord
iRec = docMail.MailMerge.DataSource.ActiveRecord
docMail.MailMerge.DataSource.ActiveRecord = wdFirstRecord
For i = 1 To iRec
    With docMail.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = i
            .LastRecord = i
            '' This will be the file name
            '' the test data source had unique surnames
            '' in a field (column) called Surname
            sFName = .DataFields("Surname").Value
        End With
        .Execute Pause:=False
        Set docLetters = ActiveDocument
    End With
    docLetters.ExportAsFixedFormat OutputFileName:= _
        "Z:docs" & sFName & ".pdf", ExportFormat:= _
        wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
    docLetters.Close False
    docMail.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next

Answer 2

首先，让我在应得的功劳上给予功劳，因为我对编写宏一无所知。 事实上，这是我第一次尝试使用宏，更不用说修改代码了。 只有 24 年的 Basic 知识（是的，原始的，不是 Visual Basic）和 Fortran（不，不是打孔卡 Fortan，但真的很接近），我从 http://raduner.ch/blog/microsoft-word-mail-merge-into-single-documents 中获取了 Raduner 先生的宏，用于生成上述 pdf 的 Remou 宏代码，以及其他一些，并结合了不同的方面和 PRESTO!! 我显然很幸运，但它适用于MS Word 2010。 希望它也适用于其他人。 我正在加载个人 pdf 创建者和个人 Word 文件创建者。我希望了解Visual Basic的人能够清理它，并使其对其他人更加用户友好。

单个 Word 文件宏（请注意，Excel 数据源中必须有"文件名"列）：

Sub SaveIndividualWordFiles()
Dim iRec As Integer
Dim docMail As Document
Dim docLetters As Document
Dim savePath As String
Set docMail = ActiveDocument
''There is a problem with the recordcount property returning -1
''http://msdn.microsoft.com/en-us/library/office/ff838901.aspx
savePath = ActiveDocument.Path & ""
docMail.MailMerge.DataSource.ActiveRecord = wdLastRecord
iRec = docMail.MailMerge.DataSource.ActiveRecord
docMail.MailMerge.DataSource.ActiveRecord = wdFirstRecord
For i = 1 To iRec
 With docMail.MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = i
        .LastRecord = i
        '' This will be the file name
        '' the test data source had unique surnames
        '' in a field (column) called FileName
        sFName = .DataFields("FileName").Value
    End With
    .Execute Pause:=False
    Set docLetters = ActiveDocument
  End With
' Save generated document and close it after saving
        docLetters.SaveAs FileName:=savePath & sFName
        docLetters.Close False
  docMail.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next
End Sub