Word 2007/2010 Mail Merge to save to individual PDF files

[kryptonian]

I tried using gmayor's Individual Merge Letters solution but my file only closes without doing anything so I am posting here as a last recourse...

Here's what I want to do --

I'm using Word 2007/2010 mail merge and I want to create individual PDF files. Currently, we do it the long way, saving it one PDF at a time using Save As. This works if it only a handful of letters but it becomes a pain when we're processing hundreds! Data source is an Excel file.

Any help would be greatly appreciated!

 

[Saved]

Tried it Paul, no luck. Word crashes

 

[Macropod]

I ran a test on a file with 700 records using the suggested changes and the code ran to completion with no errors. That suggests an error in your implementation.

 

[Saved]

Would you be kind enough to post the code, I'm somehow not able to get it running. Tried numerous times.

 

[Macropod]

The mods are pretty basic. Attached is the revised code. I've made a couple of other adjustments - like making use of your otherwise unused 'MainDoc' variable and tidying the code structure - but none of that has any effect on whether the code runs or crashes (which it doesn't).

Sub merge1record_at_a_time() '
' merge1record_at_a_time Macro
'
Dim fd As FileDialog, vrtSelectedItem, SelectedPath As String
'Create a FileDialog object as a Folder Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
    'Use the Show method to display the Folder Picker dialog box and return the user's action.
    'The user pressed the button.
    If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
            'vrtSelectedItem is aString that contains the path of each selected item.
            'You can use any file I/O functions that you want to work with this path.
            'This example displays the path in a message box.
            SelectedPath = vrtSelectedItem
        Next vrtSelectedItem
    Else
        MsgBox ("No Directory Selected.  Exiting")
        Exit Sub
    End If
End With
'Set the object variable to Nothing.
Set fd = Nothing
Application.ScreenUpdating = False
Dim MainDoc As Document, i As Long, docName As String
Set MainDoc = ActiveDocument
For i = 1 To MainDoc.MailMerge.DataSource.RecordCount
    With MainDoc.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = i
            .LastRecord = i
            .ActiveRecord = i
            docName = .DataFields("Candidate_Regn_ID").Value & ".PDF"      ' ADDED CODE
        End With
        .Execute Pause:=False
    End With
    If i Mod 100 = 0 Then DoEvents
    With ActiveDocument
      .SaveAs FileName:=SelectedPath & "\" & docName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      .Close SaveChanges:=False
    End With
Next i
Set MainDoc = Nothing
Application.ScreenUpdating = True
End Sub

PS: You might want to experiment with changing the 100 in 'i Mod 100' to a lower or higher number for possible improvements in performance.

 

[Saved]

Still not working and I'm now sure it's a problem at my side. I'll try it on another system and it should hopefully work. Thanks a ton!

 

[Saved]

Tried it on another system and it now works well, thanks again! Does slow down a bit, but only after many hours of running. It resumes speed once I restart Word, guess I'll just have to make do with it now.
I'm also noticing that the macro continues running even if the image is not inserted into the document, is there a way to get it to stop when an image is not found?

 

[Macropod]

I'm also noticing that the macro continues running even if the image is not inserted into the document, is there a way to get it to stop when an image is not found?

There is nothing in the code that has anything to do with images, so it's a bit hard to tell it to do that. You might also check and ensure that the data source doesn't have empty used rows that add to processing time without producing any output.

 

[petiokos]

Hi,
I am using this macro successfully for PDF since a while now. I am not an experienced macro user sadly thus I would need some help on how the macro could be transformed in order to create .doc or .docx as output format instead of pdf. The macro in the post #3 does not work for me. I would be really thankful for any help.

This is a version that function for .pdf

Sub Merge_to_pdf() '
' merge1record_at_a_time Macro
'
'
    Dim fd As FileDialog


    'Create a FileDialog object as a Folder Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd


        'Use the Show method to display the Folder Picker dialog box and return the user's action.
        'The user pressed the button.
        If .Show = -1 Then
                For Each vrtSelectedItem In .SelectedItems


                'vrtSelectedItem is aString that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example displays the path in a message box.
        SelectedPath = vrtSelectedItem


        Next vrtSelectedItem


        Else
        MsgBox ("No Directory Selected.  Exiting")
        Exit Sub
        End If
    End With


    'Set the object variable to Nothing.
    Set fd = Nothing


Application.ScreenUpdating = False


MainDoc = ActiveDocument.Name
    ChangeFileOpenDirectory SelectedPath
    For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
        With ActiveDocument.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = i
                .LastRecord = i
                .ActiveRecord = i
                docName = "Lettera_UMTS_01_2014_" & .DataFields("PK_Assegnatario").Value & ".pdf"      ' ADDED CODE
            End With
            .Execute Pause:=False
    Application.ScreenUpdating = False
            
        End With
    ActiveDocument.ExportAsFixedFormat OutputFileName:=docName, _
        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
    ActiveWindow.Close SaveChanges:=False
    

    Next i
Application.ScreenUpdating = True

End Sub

 

[Macropod]

Using the code in post #94, change:
docName = .DataFields("Candidate_Regn_ID").Value & ".PDF" ' ADDED CODE
to:
docName = "Lettera_UMTS_01_2014_" & .DataFields("PK_Assegnatario").Value & ".docx" ' ADDED CODE
and change:
.SaveAs FileName:=SelectedPath & "" & docName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
to:
.SaveAs FileName:=SelectedPath & "" & docName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False

 

[petiokos]

Thank you! This was very helpful!

Using the code in post #94, change:
docName = .DataFields("Candidate_Regn_ID").Value & ".PDF" ' ADDED CODE
to:
docName = "Lettera_UMTS_01_2014_" & .DataFields("PK_Assegnatario").Value & ".docx" ' ADDED CODE
and change:
.SaveAs FileName:=SelectedPath & "" & docName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
to:
.SaveAs FileName:=SelectedPath & "" & docName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False