Word - Exportar multiples PDF con nombres distintos

Sub Merge_To_Individual_Files()

'Combina cada registro, en formato pdf, con el nombre del campo CORREO, a la carpeta en la que está este documento de combinación

'Creado por https://wordexperto.com/

Application.ScreenUpdating = False

Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long

Const StrNoChr As String = """*./\:?|"

Set MainDoc = ActiveDocument

With MainDoc

  StrFolder = .Path & Application.PathSeparator

  For i = 1 To .MailMerge.DataSource.RecordCount

    With .MailMerge

      .Destination = wdSendToNewDocument

      .SuppressBlankLines = True

      With .DataSource

        .FirstRecord = i

        .LastRecord = i

        .ActiveRecord = i

        If Trim(.DataFields("CORREO")) = "" Then Exit For

        'StrFolder = .DataFields("Folder") & Application.PathSeparator

        StrName = .DataFields("CORREO")

      End With

      On Error Resume Next

      .Execute Pause:=False

      If Err.Number = 5631 Then

        Err.Clear

        GoTo NextRecord

      End If

    End With

      For j = 1 To Len(StrNoChr)

        StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")

      Next

    StrName = Trim(StrName)

    With ActiveDocument

      .SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False

      .Close SaveChanges:=False

    End With

NextRecord:

  Next i

End With

Application.ScreenUpdating = True

End Sub