VBA - How to split a word direct mail into multiple files . pdf

Question

Personally, my case is as follows: I participate in the organization of some events in the area of IT and free software and the printing of certificates is always a problem. In the last event I participated as an organizer the mission was to issue the certificates in a digital way, generating a PDF file for each certificate. How can I split a direct mail into different files, with custom PDF names?

Answer 1

So the solution I found was to use VBA for application. The instructions:

1- Create direct mail in Word with the name of the participants and other information that is required.

2- Merge direct mail so that the end result is a Word file with all certificates.

3- In the file with all certificates, write the following VBA code:

Sub BreakOnSection()
Dim Arquivo As Integer
Dim CaminhoArquivo As String
Dim TextoProximaLinha As String

'Set reading the file that contains the names of files that will be generated.
Arquivo = FreeFile
CaminhoArquivo = "F:\Documentos\Evento\participantes.txt"

'Open file for reading.
Open CaminhoArquivo For Input As Arquivo

'Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection

'A mail merge 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)   
    'Note: If a document does not end with a section break,
    'substitute the following line of code for the one above:
    'For I = 1 To ActiveDocument.Sections.Count

    '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
    Selection.Paste

    'Altera a orientação da página para paisagem
    Orientation
    'Deletes the last page (use only if necessary)
    DeleteLastLine

    '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 "F:\Documentos\Evento\Certificados\"

    'It makes the line reading
    Line Input #Arquivo, TextoProximaLinha
    TextoProximaLinha = TextoProximaLinha

    'Export to .pdf and customize the file name to the line that was read
     ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    "F:\Documentos\Evento\Certificados\" & TextoProximaLinha & ".pdf" _
    , 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

    'Closes the "temporary" file from Word without saving changes
    ActiveDocument.Close savechanges:=wdDoNotSaveChanges
    'Move the selection to the next section in the document.
    Application.Browser.Next
Next i
        ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Sub Orientation()
    'If the page orientation is portrait in it is changed to landscape
    'This is a particular case in issuing certificates. Make sure that in your case there is a need
    If Selection.PageSetup.Orientation = wdOrientPortrait Then
        Selection.PageSetup.Orientation = wdOrientLandscape
    Else
    Selection.PageSetup.Orientation = wdOrientPortrait
    End If
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
End Sub

Sub DeleteLastLine()
'This is a particular case in issuing certificates. Make sure that in your case there is a need
    Selection.HomeKey Unit:=wdStory
    Selection.EndKey Unit:=wdStory
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
End Sub

4- Execute and be happy! = D

Answer 2

I had a similar need, so I adapted some codes and turned them into two: one saved in . docx (Macro 1) and the other in . pdf (Macro 2), both generate individual files and with the name of the column you choose, just add the code in the master file.

Macro 1:

Sub SalvarComoDOCIndividual()

Dim a As Integer

Dim registro As Integer

Dim nomeArquivo As String

'Define o primeiro registro da mala direta

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

'Contador de registros

a = ActiveDocument.MailMerge.DataSource.RecordCount

'Salva todos os registros

For registro = 1 To a

    'Atribui o valor de cada registro da coluna nome para a variável nomeArquivo que dará nome ao novo arquivo. Caso queira outro nome, basta colocar o nome da coluna desejada
    nomeArquivo = ActiveDocument.MailMerge.DataSource.DataFields("Nome").Value 

    ActiveDocument.SaveAs2 FileName:= _
        "C:\Users\Lera\Desktop\" & nomeArquivo & ".docx", FileFormat:= _
    wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
    :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
    :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
    SaveAsAOCELetter:=False, CompatibilityMode:=15

    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

    Next registro

    End

End Sub


'Trocar C:\Users\Lera\Desktop\ pelo caminho da pasta onde será salvo os arquivos gerados

Macro 2:

Sub SalvarComoPDF()

Dim a As Integer

Dim registro As Integer

Dim nomeArquivo As String

'Define o primeiro registro da mala direta

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

'Contador de registros

a = ActiveDocument.MailMerge.DataSource.RecordCount

'Exporta todos os registros

For registro = 1 To a

    'Atribui o valor de cada registro da coluna nome para a variável nomeArquivo que dará nome ao novo arquivo. Caso queira outro nome, basta colocar o nome da coluna desejada
    nomeArquivo = ActiveDocument.MailMerge.DataSource.DataFields("Nome").Value 

    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        "C:\Users\Lera\Desktop\" & nomeArquivo & ".pdf" _
        , 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

    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

    Next registro

    End

End Sub


'Trocar C:\Users\Lera\Desktop\ pelo caminho da pasta onde será salvo os arquivos gerados

Answer 3

You don’t need that code all my dear.

Just create this code below in the master document and run it.

Reminder: the first field of the direct mail must be the student’s name or must change to the correct number of your database in the code (Name = Activedocument.MailMerge.Datasource.DataFields.Item(1).Value) to the correct name.

Code

Sub GeraCertificadoPDF()
'
' Macro GeraCertificadoPDF
' Gera arquivos em pdf a partir de mala direta via VBA
'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
    For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount

        Nome = ActiveDocument.MailMerge.DataSource.DataFields.Item(1).Value

        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        "c:\temp\Certificados\" & Nome & ".pdf" _
        , 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

        ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

    Next i
End Sub

Answer 4

Sub Macro1()

 Macro1 Macro
 Cria PDF de mala direta do word 2016

Set Mail Merge in the first register
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
Mail Merge Count
qtde = 94
qtde = ActiveDocument.MailMerge.DataSource.RecordCount
arquivo = ActiveDocument.MailMerge.DataSource.FieldNames(1).Name
nome = "Nome do seu arquivo" & ActiveDocument.MailMerge.DataSource.DataFields("nickname").Value
Do While qtde > 0
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    "D:\dir1\subdir1\subdir2\subdir3\" & nome & ".pdf", 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
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
nome = "Nome do seu arquivo" & ActiveDocument.MailMerge.DataSource.DataFields("nickname").Value
qtde = qtde - 1
Loop
End Sub