Word - Merge Mail Macro para crear pdfs individuales

Sub merge1record_at_a_time() '

' 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

    For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount

        SelectedPath = .DataFields("MyPath").Value

        ChangeFileOpenDirectory SelectedPath

        With ActiveDocument.MailMerge

            .Destination = wdSendToNewDocument

            .SuppressBlankLines = True

            With .DataSource

                .FirstRecord = i

                .LastRecord = i

                .ActiveRecord = i

                docName = .DataFields("Sigla").Value & "_" & .DataFields("Last_Name").Value & " " & .DataFields("First_Name").Value & ".pdf"

            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

'set OpenAfterExport to False so the PDF files won't open after mail merge

ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

    Windows(MainDoc).Activate

    Next i

Application.ScreenUpdating = True

End Sub