MS Word Mailmerge宏丢失格式

Question

Using MS Word 2010 I want a Mailmerge to run with a macro, saving each record out as a separate file, in PDF format using one of the fields as the filename. This will save me loads of time.

The problem i've got is that the format is being TOTALLY lost, as though it's just copying text and pasting it in a new document. Is there any way I can protect the formatting as without it it's pretty fruitless...

Thanks in advance.

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:\BACS\INVOICING\INVOICES\Word Export\" & FileNum, 17
    Target.Close
    Next i
End Sub

Answer 1

How about using Save?

This sample code loops through each mailmerge item in a mailmerge document, opens the item as a letter and saves it to a PDF using a field in the DataSource as a file name. There is no error coding and no attempt to check for duplicate file names. It is a snippet.

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

First let me give credit where credit is due because I know absolutely nothing of writing macros. In fact this is my first attempt at using a macro let alone modifying the code. Armed only with 24 year old knowledge of Basic (yes the original, not Visual Basic) and Fortran (no not the punch card Fortan but really close) I took Mr. Raduner macro from http://raduner.ch/blog/microsoft-word-mail-merge-into-single-documents , Remou macro code for producing pdf's above, and a few others and combined different aspects and PRESTO!!! I clearly got very lucky but it works in MS Word 2010. Hope it works for everyone else as well. I'm loading both individual pdf creator and individual word file creator. I hope someone that knows Visual Basic will clean this up and make it more user friendly for everyone else.

INDIVIDUAL WORD FILE MACRO (note you must have a "FileName" Column in your Excel data source):

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