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
