Mail Merge Word ke Banyak File PDF Menggunakan Macro (2)

 Sub MailMergeToPdfBasic()

    Dim masterDoc As Document

    Dim singleDoc As Document

    Dim firstRow As Long

    Dim lastRow As Long

    Dim currentRow As Long

    Dim maxRecord As Long

    Set masterDoc = ActiveDocument

    'Cari jumlah record terakhir

    masterDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord

    maxRecord = masterDoc.MailMerge.DataSource.ActiveRecord

    'Input Record Awal

    firstRow = CLng(InputBox("Masukkan Record Awal", "Mail Merge", 1))

    'Input Record Akhir

    lastRow = CLng(InputBox("Masukkan Record Akhir", "Mail Merge", maxRecord))

    'Validasi

    If firstRow < 1 Then firstRow = 1

    If lastRow > maxRecord Then lastRow = maxRecord

    If firstRow > lastRow Then

        MsgBox "Record awal tidak boleh lebih besar dari record akhir.", vbCritical

        Exit Sub

    End If

    currentRow = firstRow

    Do While currentRow <= lastRow

        masterDoc.MailMerge.DataSource.ActiveRecord = currentRow

        masterDoc.MailMerge.Destination = wdSendToNewDocument

        masterDoc.MailMerge.DataSource.FirstRecord = currentRow

        masterDoc.MailMerge.DataSource.LastRecord = currentRow

        masterDoc.MailMerge.Execute False

        Set singleDoc = ActiveDocument

        singleDoc.SaveAs2 _

            FileName:=masterDoc.MailMerge.DataSource.DataFields("DocFolderPath").Value & _

            Application.PathSeparator & _

            masterDoc.MailMerge.DataSource.DataFields("DocFileName").Value & ".docx", _

            FileFormat:=wdFormatXMLDocument

        singleDoc.ExportAsFixedFormat _

            OutputFileName:=masterDoc.MailMerge.DataSource.DataFields("PdfFolderPath").Value & _

            Application.PathSeparator & _

            masterDoc.MailMerge.DataSource.DataFields("PdfFileName").Value & ".pdf", _

            ExportFormat:=wdExportFormatPDF

        singleDoc.Close False

        currentRow = currentRow + 1

    Loop

    MsgBox "Selesai memproses record " & firstRow & " sampai " & lastRow

End Sub