Microsoft Office Forums - View Single Post - Word doc - Mail Merge Document returns compile error if only one record available

DaniMul · 08-28-2024, 03:04 PM

Hi,

I have been to the https://www.msofficeforums.com/mail-...ps-tricks.html and have adjusted the code to suit what I need it to do and have named the macro 'MailMergeToDoc' .

So when we click 'Edit Individual Documents' (In the finish & Merge tab) the macro clicks in and runs through the code saving the multiple documents as separate pages BUT if there is only one record it give a compile error that my next has no for.

I have looked through and there are two 'for' and two 'next' so one will open and close the other. it only errors if there is one record and no next record so how can I close this so if no next record it still saves and completes the macro. Code below (Sorry if hard to read I am unsure how to attach like the other codes I see in these forums)

Code:

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
        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
        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:
       Next i 'THIS IS WHERE COMPILE ERROR HAPPENS IF ONLY ONE RECORD'
  End With
End With
Application.ScreenUpdating = True
End Sub