Sub Merge_To_Individual_Files()
'Merges one record at a time to the chosen output folder
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j as long
Set MainDoc = ActiveDocument
With MainDoc
  StrFolder = .Path & "\"
  For i = 1 To .MailMerge.DataSource.RecordCount
    With .MailMerge
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        If Trim(.DataFields("Last_Name")) = "" Then Exit For
        StrName = .DataFields("Last_Name") & "_" & .DataFields("First_Name")
      End With
      .Execute Pause:=False
    End With
    For j = 1 To 255
      Select Case j
        Case 1 To 31, 33 To 45, 47, 58 To 64, 91 To 94, 96, 123 To 141, 143 To 149, 152 To 157, 160 To 180, 182 To 191
        StrName = Replace(StrName, Chr(j), "")
      End Select
    Next
    StrName = Trim(StrName)
    With ActiveDocument
      .SaveAs2 FileName:=StrPath & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      .Close SaveChanges:=False
    End With
  Next i
End With
Application.ScreenUpdating = True
End Sub