CODEWITHSUNDEEP
vbams-wordms-officemailmerge
MT_
MT_

Reputation: 116

Export individual documents from mail merge

How would I create individuals files from mail merge rather than the one large file that is output by the mail merge function in Microsoft Office?

I was hoping to be able to save each letter than was created as a name of one of the merge fields, but I haven't been able to find an intuitive way so far...

Upvotes: 0

Views: 32591

Answers (3)

John
John

Reputation: 1816

I modified Parth's answer since it didn't work for me.

Sub SaveAsFileName()
Dim FileName  As String
With ActiveDocument.MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True

    For SectionCount = 1 To .DataSource.RecordCount
        With .DataSource
            ActiveDocument.MailMerge.DataSource.ActiveRecord = SectionCount
            ActiveDocument.MailMerge.DataSource.FirstRecord = SectionCount
            ActiveDocument.MailMerge.DataSource.LastRecord = SectionCount

            ' replace Filename with the column heading that you want to use - can't have certain symbols in the name
            FileName = .DataFields("Filename").Value
        End With

        'Get path and file name
        FullPathAndName = ActiveDocument.Path & Application.PathSeparator & FileName & ".docx"

        ' Merge the document
        .Execute Pause:=False

        ' Save resulting document.
        ActiveDocument.SaveAs (FullPathAndName)
        ActiveDocument.Close False
    Next
End With
End Sub

Upvotes: 2

Parth Parmar
Parth Parmar

Reputation: 31

Recently I've come across the similar situation where I want to save individual files in pdf format rather than saving one large file created by Mail merge function. I've written down this small function to save individual file in pdf format.

Sub SaveAsPDF()
Dim CouncilName  As String   
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        For SectionCount = 1 To .DataSource.RecordCount
            With .DataSource
                'FirstRecord and LastRecords defines how many data records needs to be merge in one document.
                'createing pdf file for each data record so in this case they are both pointing to ActiveRecord.
                .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
                .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord

                'get the council name from data source 
                CouncilName = .DataFields("Council").Value  

                'move to next datasource record.
                If .ActiveRecord <> .RecordCount Then
                    .ActiveRecord = wdNextRecord
                End If
            End With

            'Get path and file name 
            PDFPathAndName = ActiveDocument.Path & Application.PathSeparator & "FINAL - " & CouncilName & ".pdf"

            ' Merge the document
            .Execute Pause:=False

            ' Save resulting document.
            Set PDFFile = ActiveDocument
            PDFFile.ExportAsFixedFormat PDFPathAndName, wdExportFormatPDF
            PDFFile.Close 0
        Next
    End With
End Sub

Upvotes: 3

Arunkumar Nehru
Arunkumar Nehru

Reputation: 36

as of my experience, there is no option to save individual files, instead you can use Macro to spit the files and save it individually with specific name that you want. I have tried the same and succeeded with what want. Hope the below code helps you as well to achieve you goal.

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
      'To save your document with the original formatting'
      Selection.PasteAndFormat (wdFormatOriginalFormatting)

      '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

Please revert me for any clarifications.

Upvotes: 2

Related Questions