Microsoft Office Forums - View Single Post - [Solved] Mail Merge with Merged File Name in Footer

DM2 · 04-30-2019, 07:16 PM

We often have a need to create cover pages for technical documents submitted to clients. Mail Merge to a PDF seems to be the simplest solution. I've read several posts on the subject:

But ended up using a AddIn from "Greg Mayor" (http://www.gmayor.com/individual_merge_letters.htm) as it has provided me the a "best fit" solution.

The AddIn permits me to "...run a macro before saving the documents..." with a caveat that...

Quote:

In order to ensure that macros applied to this process actually run on the document they must pass a document parameter to the macro e.g. Sub MacroName(oDoc as Document). The variable name itself does not matter. In the following code example, a ® characters are formatted with the Segoe UI font and are superscripted. (The sample document includes such characters so that you may evaluate the results).

...and provides the below example:

Code:

Sub FormatTM(oDoc As Document)
     Dim oRng As Range
     Set oRng = oDoc.Range
     With oRng.Find
          Do While .Execute(FindText:=ChrW(174))
               With oRng.Font
                    .name = "Segoe UI"
                    .Superscript = True
               End With
          Loop
     End With
End Sub

Doug Robbins (Word MVP) offered some code to do this (https://answers.microsoft.com/en-us/...f-e67f916252f9), which I've highlighted in red below (with my additions in Blue, and the additional requirements from Greg Mayor, in Green):

Code:

Sub FooterTx()(oDoc As Document)
    Dim i As Long, Source As Document, Target As Document, Letter As Range
    Dim fname As Range
    Set Source = ActiveDocument
    With Source
        For i = 1 To .Sections.Count
            Set fname = .Sections(i).Footers(wdHeaderFooterPrimary).Range
            fname.End = fname.End - 1
            Set Letter = .Sections(i).Range
            Letter.End = Letter.End - 1
            Set Target = Documents.Add
            With Target
                .Range.FormattedText = Letter.FormattedText
                .Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = ""
                .SaveAs FileName:=fname.Text & " - Contributions", FileFormat:=wdFormatPDF
                .Close wdDoNotSaveChanges
            End With
        Next i
    End With
End Sub

I know I'm missing the setting the variable "Odoc", but i'm not sure where to place it in the macro.

Doug Robbins code by itself works for me, but not in the Addit.

Anyone's help would be appreciated.