Public Sub Merge_To_Individual_Files()
  Dim StrFolder As String, MainDoc As Document, i As Long
  Set MainDoc = ActiveDocument
  StrFolder = MainDoc.Path & "\"
  With MainDoc.MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    .ViewMailMergeFieldCodes = False
    With .DataSource
      .ActiveRecord = wdFirstRecord
      Do Until i = .ActiveRecord  'next record didn't go forward
        MainDoc.SaveAs FileName:=StrFolder & i & "temp.pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
        i = .ActiveRecord
        .ActiveRecord = wdNextRecord
      Loop
    End With
  End With
End Sub