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]

You don't need any code for that; all you need do is define the appropriate mailmerge filters in the mailmerge main document. The links in post 81 (Word 2007/2010 Mail Merge to save to individual PDF files) point to all the code all you need - unless you want to force the user to choose the output folder each time.

Paul, is there a way to specify the pdf quality in this code? I run 1000s of files via this code and they all end up getting saved with print quality (big file size), whereas I just need them with minimal screen viewing quality. I know there are two quality options in Word when we save as pdf, but how do we do that in the code please?

 

[Macropod]

No. To do that, you'd need to use the ExportAsFixedFormat Method with OptimizeFor:=wdExportOptimizeForOnScreen. For some sample ExportAsFixedFormat code, see post #73 in this thread.

 

[Saved]

Thank you for replying Paul, unfortunately I have been using this macro with just a 'copy-paste' approach all these years and it works perfect to this day. I am nowhere close to writing/editing the code myself. Below is the code I use. Would be very grateful if you could help me out.

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("reg_no").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

 

[Macropod]

Change:

    With ActiveDocument
      .SaveAs FileName:=SelectedPath & "\" & docName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      .Close SaveChanges:=False
    End With

to:

    With ActiveDocument
      .ExportAsFixedFormat OutputFileName:=SelectedPath & "\" & docName, _
          ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
          OptimizeFor:=wdExportOptimizeForOnScreen, Range:=wdExportAllDocument, _
          From:=1, To:=1, Item:=wdExportDocumentContent, IncludeDocProps:=True, _
          KeepIRM:=True, CreateBookmarks:=wdExportCreateNoBookmarks, _
          DocStructureTags:=True, BitmapMissingFonts:=True, UseISO19005_1:=False
      .SaveAs FileName:=SelectedPath & "\" & docName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      .Close SaveChanges:=False
    End With

 

[Saved]

Thank you again Paul, I implemented this and the macro runs perfect, but for some reason the file sizes are the same as before (around 1.5 MB). However, if I manually save as pdf in Word with minimal quality it is showing 800 kb.

 

[Macropod]

You might try setting some/all of the other 'True' properties to 'False', in case the added metadata is increasing the file sizes. I can't see that making a dramatic difference, though.