Sub MailMergeToDoc()
  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 & ""
    StrFolder = Replace(StrFolder, "TEMPLATES for ", "")
    With .MailMerge
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      On Error Resume Next
      If .DataSource.RecordCount = 0 Then Exit Sub    'added this line
      For i = 1 To .DataSource.RecordCount
        With .DataSource
          .FirstRecord = i
          .LastRecord = i
          .ActiveRecord = i
          If Trim(.DataFields("Property")) = "" Then Exit For
          StrName = .DataFields("Property") & " - " & .DataFields("Formated_Date") & " " & .DataFields("Premises_")
        End With
        On Error GoTo NextRecord
        .Execute Pause:=False
        ' skip over unticked rejections
        ' If Err.Number = 5631 Then Err.Clear   'line disabled
        GoTo NextRecord
        For j = 1 To Len(StrNoChr)
          StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
        Next
        StrName = Trim(StrName)
        With ActiveDocument
          'Add the name to the footer
          '.Sections(1).Footers(wdHeaderFooterPrimary).Range .InsertBefore StrName
          ' SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
          ' and/or:
          .SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
          .Close SaveChanges:=False
        End With
NextRecord:
      If .DataSource.ActiveRecord = .DataSource.LastRecord Then Exit For      'added this line
      Next i 'THIS IS WHERE COMPILE ERROR HAPPENS IF ONLY ONE RECORD'
    End With
  End With
  Application.ScreenUpdating = True
End Sub