Word Mail Merge to Individual Named PDF Files

I think I may have a work around if it's not possible.

After merging the PDF file, I can use the program 'PDF Split & Merge' to split the PDFs every 9 pages. I'll then have to manually rename them. Unless there is a way to automatically rename them. :)

You will have to execute the merge which will produce a 900 paged document which you can then split and rename into 100 separate files.

I haven't tested this code recently, but it should give you an idea of the required algorithm:

Sub SplitIntoSeparatePDFs()

    Dim oDocMultiple As Document
    Dim oDocSingle As Document
    Dim oRngPage As range
    Dim iCurrentPage As Long, iPageCount As Long
    Dim strNewFileName As String

    Application.ScreenUpdating = False

    ' path to original (long) document
    Set oDocMultiple = Documents.Open("C:\Expert-Exchange Demos\Original Document.docx")
    'instantiate the range object
    Set oRngPage = oDocMultiple.range

    iCurrentPage = 1
    'get the original document's page count
    iPageCount = oDocMultiple.Content.ComputeStatistics(wdStatisticPages)

    Do Until iCurrentPage > iPageCount
        If iCurrentPage = iPageCount Then
            'last page (there won't be a next page)
            oRngPage.End = ActiveDocument.range.End
        Else
            'Find the beginning of the next page
            'Must use the Selection object. The Range.Goto method will not work on a page
            Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
            'Set the end of the range to the point between the pages
            oRngPage.End = Selection.start
        End If

        'copy the page into the Windows clipboard
        oRngPage.Copy

        'create a new document
        Set oDocSingle = Documents.Add

        'paste the clipboard contents to the new document
        oDocSingle.range.Paste

        'remove any manual page break to prevent a second blank
        oDocSingle.range.Find.Execute Findtext:="^m", ReplaceWith:=""

        'build a new sequentially-numbered file name based on the original multi-paged file name and path
        strNewFileName = oDocMultiple.Path & "\" & iCurrentPage & ".PDF"

        Debug.Print strNewFileName

        'save the new single-paged document
        oDocSingle.SaveAs FileName:=strNewFileName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False

        'move to the next document (9 pages later)
        iCurrentPage = iCurrentPage + 9

        'close the new document without saving
        oDocSingle.Close SaveChanges:=wdDoNotSaveChanges

        'go to the next page
        oRngPage.Collapse wdCollapseEnd
    Loop

    Application.ScreenUpdating = True

End Sub

Select allOpen in new window

Thanks for the code. Good notations.

The code looks like it applies a sequential naming system. Is it possible to name the PDFs based on another data source? So they are saved as (for example):

dog.pdf
cat.pdf
mouse.pdf

i.e there's no sequential logic. If not, I can just use the PDF splitter function and rename post extraction.

Sure. Create an array containing the desired names, then for each iteration of the loop pull a different value.

Sub SplitIntoSeparatePDFs()

    Dim oDocMultiple As Document
    Dim oDocSingle As Document
    Dim oRngPage As Range
    Dim iCurrentPage As Long, iPageCount As Long
    Dim strNewFileName As String
    Dim arrFileNames() As String
    Dim i As Long

    Application.ScreenUpdating = False

    ' path to original (long) document
    Set oDocMultiple = Documents.Open("C:\Expert-Exchange Demos\Original Document.docx")
    'instantiate the range object
    Set oRngPage = oDocMultiple.Range
    ' put all file names in an array
    arrFileNames = Array("dog.pdf", "cat.pdf", "mouse.pdf")

    iCurrentPage = 1
    'get the original document's page count
    iPageCount = oDocMultiple.Content.ComputeStatistics(wdStatisticPages)

    Do Until iCurrentPage > iPageCount
        If iCurrentPage = iPageCount Then
            'last page (there won't be a next page)
            oRngPage.End = ActiveDocument.Range.End
        Else
            'Find the beginning of the next page
            'Must use the Selection object. The Range.Goto method will not work on a page
            Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
            'Set the end of the range to the point between the pages
            oRngPage.End = Selection.Start
        End If

        'copy the page into the Windows clipboard
        oRngPage.Copy

        'create a new document
        Set oDocSingle = Documents.Add

        'paste the clipboard contents to the new document
        oDocSingle.Range.Paste

        'remove any manual page break to prevent a second blank
        oDocSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""

        'build a new file name based on the original multi-paged path and name from the array
        strNewFileName = oDocMultiple.Path & "\" & arrFileNames(i)


        Debug.Print strNewFileName

        'save the new single-paged document
        oDocSingle.SaveAs Filename:=strNewFileName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False

        'move to the next document (9 pages later)
        iCurrentPage = iCurrentPage + 9

        'close the new document without saving
        oDocSingle.Close SaveChanges:=wdDoNotSaveChanges

        'go to the next page
        oRngPage.Collapse wdCollapseEnd
        
        i = i + 1
    Loop

    Application.ScreenUpdating = True

End Sub

Select allOpen in new window

Ok, so just confirming (because I have very low experience in macros). I can just type all the arrays into row 18 of your supplied code and the PDFs will be created with those names?

If so, that's so cool. I'll just code a formula in Excel, then copy and paste that array output into your Word Macro.

I will check in 12 hours.

Correct.

You will have to make sure though that the array contains the proper amount of file names.

Hi,

I tried the following code with the attached sample document (30 pages). However I get runtime error 13 on line 18 (type mismatch).  Are you able to help?

Sub SplitIntoSeparatePDFs()

    Dim oDocMultiple As Document
    Dim oDocSingle As Document
    Dim oRngPage As Range
    Dim iCurrentPage As Long, iPageCount As Long
    Dim strNewFileName As String
    Dim arrFileNames() As String
    Dim i As Long

    Application.ScreenUpdating = False

    ' path to original (long) document
    Set oDocMultiple = Documents.Open("C:\Temp\test.docx")
    'instantiate the range object
    Set oRngPage = oDocMultiple.Range
    ' put all file names in an array
    arrFileNames = Array("1dog.pdf", "2cat.pdf", "3mouse.pdf")

    iCurrentPage = 1
    'get the original document's page count
    iPageCount = oDocMultiple.Content.ComputeStatistics(wdStatisticPages)

    Do Until iCurrentPage > iPageCount
        If iCurrentPage = iPageCount Then
            'last page (there won't be a next page)
            oRngPage.End = ActiveDocument.Range.End
        Else
            'Find the beginning of the next page
            'Must use the Selection object. The Range.Goto method will not work on a page
            Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
            'Set the end of the range to the point between the pages
            oRngPage.End = Selection.Start
        End If

        'copy the page into the Windows clipboard
        oRngPage.Copy

        'create a new document
        Set oDocSingle = Documents.Add

        'paste the clipboard contents to the new document
        oDocSingle.Range.Paste

        'remove any manual page break to prevent a second blank
        oDocSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""

        'build a new file name based on the original multi-paged path and name from the array
        strNewFileName = oDocMultiple.Path & "\" & arrFileNames(i)


        Debug.Print strNewFileName

        'save the new single-paged document
        oDocSingle.SaveAs FileName:=strNewFileName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False

        'move to the next document (10 pages later)
        iCurrentPage = iCurrentPage + 10

        'close the new document without saving
        oDocSingle.Close SaveChanges:=wdDoNotSaveChanges

        'go to the next page
        oRngPage.Collapse wdCollapseEnd
        
        i = i + 1
    Loop

    Application.ScreenUpdating = True

End Sub

Select allOpen in new window

test.docx

Change line 8 from:

Dim arrFileNames() As String 

Select allOpen in new window

to :

Dim arrFileNames() As Variant

Select allOpen in new window

Great - it's splitting into 3 PDFs. Only thing is -


Is there a way to make all PDFs export as 10 pages?

Hi.

It's adding a blank extra page at the end of each PDF. But apart from that everything is fine.

My template document is now 9 pages, so I changed all the 10's to 9's.

Hi MacroShadow,

Just wondering if you've had a chance to show me how to edit the code so it doesn't add a blank page to the end?

Cheers.

Try repeating line 48 again. If that doesn't help try adding this line after line 48:

oDocSingle.Range.Find.Execute Findtext:="^12", ReplaceWith:=""

Select allOpen in new window

No luck unfortunately. I tried:

1.  Duplicating the 48th line
2. Adding the 49th line
3. Duplicating the 48th line and adding the 49th line

On all occasions the  10th blank page was added

I'm not sure why the blank page is added. If you can save the separate files as word files (by changing line 57 to: oDocSingle.SaveAs FileName:=strNewFileName & ".docx", FileFormat:=wdFormatDocument, AddToRecentFiles:=False) and then upload one of the files I can determine how to deal with it.

Ok, Attached is the exported word doc (2003). Note that the correct pages are 1-9 (landscape). The added page is portrait at the end.
Test-Doc.doc

dabug80,

do you have Acrobat Pro?  If you have this with the plugin for Word, you simply setup mail merge from your data source as you would and then use the 'Merge to Adobe Pdf button to create individual PDFs. You can also specify a Root filename to which a numeric extension is applied.

You can trial Acrobat for 30Days:
https://www.acrobat.com/en_us/free-trial-download.html?trackingid=KKYXC

hth
capt.

do you have Acrobat Pro?  If you have this with the plugin for Word, you simply setup mail merge from your data source as you would and then use the 'Merge to Adobe Pdf button to create individual PDFs.

Hi Capt.

No, I don't have Acrobat Pro. The code is so close to working - all it needs to do is remove the blank page at the end and it would be perfect.

Add the following code after line 48:

    With oDocSingle.Content.Find
        .Text = "^13"
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
    End With
    If Selection.PageSetup.Orientation = wdOrientPortrait Then
        Selection.PageSetup.Orientation = wdOrientLandscape
    Else
        Selection.PageSetup.Orientation = wdOrientPortrait
    End If

Select allOpen in new window

Ok, thanks for the update just thought I bring this to your attention on the off-chance you had this installed :)

Good luck with the project
capt.

Hi MacroShadow,

Could you please confirm the total code that you are recommending?

Option Explicit

Sub SplitIntoSeparatePDFs()

    Dim oDocMultiple As Document
    Dim oDocSingle As Document
    Dim oRngPage As Range
    Dim iCurrentPage As Long, iPageCount As Long
    Dim strNewFileName As String
    Dim arrFileNames() As Variant
    Dim i As Long

    Application.ScreenUpdating = False

    ' path to original (long) document
    Set oDocMultiple = ActiveDocument    'Documents.Open("C:\Temp\test.docx")
    'instantiate the range object
    Set oRngPage = oDocMultiple.Range
    ' put all file names in an array
    arrFileNames = Array("1dog.pdf", "2cat.pdf", "3mouse.pdf")

    iCurrentPage = 1
    'get the original document's page count
    iPageCount = oDocMultiple.Content.ComputeStatistics(wdStatisticPages)

    Do Until iCurrentPage > iPageCount
        If iCurrentPage = iPageCount Then
            'last page (there won't be a next page)
            oRngPage.End = ActiveDocument.Range.End
        Else
            'Find the beginning of the next page
            'Must use the Selection object. The Range.Goto method will not work on a page
            Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 10
            'Set the end of the range to the point between the pages
            oRngPage.End = Selection.Start
        End If

        'copy the page into the Windows clipboard
        oRngPage.Copy

        'create a new document
        Set oDocSingle = Documents.Add

        'paste the clipboard contents to the new document
        oDocSingle.Range.Paste

        'remove any manual page break to prevent a second blank
        oDocSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""

        With oDocSingle.Content.Find
            .Text = "^13"
            .Replacement.Text = ""
            .Execute Replace:=wdReplaceAll
        End With

        If Selection.PageSetup.Orientation = wdOrientPortrait Then
            Selection.PageSetup.Orientation = wdOrientLandscape
        Else
            Selection.PageSetup.Orientation = wdOrientPortrait
        End If

        'build a new file name based on the original multi-paged path and name from the array
        strNewFileName = oDocMultiple.Path & "\" & arrFileNames(i)

        Debug.Print strNewFileName

        'save the new single-paged document
        oDocSingle.SaveAs FileName:=strNewFileName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False

        'move to the next document (10 pages later)
        iCurrentPage = iCurrentPage + 10

        'close the new document without saving
        oDocSingle.Close SaveChanges:=wdDoNotSaveChanges

        'go to the next page
        oRngPage.Collapse wdCollapseEnd

        i = i + 1
    Loop

    Application.ScreenUpdating = True

End Sub

Select allOpen in new window

Thanks.

The code is making the first page of the document go portrait. And it's adding another page at the end. I think I'm going to stick with your previous solution (2014-09-02 at 19:04:00) and just manually delete the last PDF page.

I don't want to keep you hacking away at it.

Hi dabug80,
I know I'm late to the party here, but I just got wind of the question when Netminder added Topic Areas. It seems that you're close to a satisfactory solution (great job by MacroShadow!), but I'm curious about one thing. Is the file name that you would like to use for the renaming (dog.pdf, cat.pdf, mouse.pdf, etc.) somewhere in the contents of the file itself? If so, is it in a fixed location, such as starting in column 16 on the second line of the first page? Or does the name you want to give the file appear after some identifier string, such as Customer Name or Account Number or SSN? Also, one more question: Is this a one-time effort or something that you'll be doing periodically — daily, weekly, monthly, whatever? I ask this because a one-time manual effort to delete each blank page at the end of the 100 docs isn't so bad, but if this is going to be a recurring task, it may be worth some extra effort to come up with a completely automated solution. Regards, Joe

Almost perfect solution. I just have to delete the last PDF page.

Hi dabug80,
Even though you closed the question, I'm hoping you'll be willing to answer the questions in my previous post <http:#a40371017>. Thanks, Joe

TRY THIS WEBSITE https://mailmergepdf.blogspot.in

Hi,

Download "Advanced Document Generator  from https://mailmergepdf.blogspot.in
You can generate PDF files from mail merge.
You can do lots of things using this software.