Word doc - Mail Merge Document returns compile error if only one record available

DaniMul · #1 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

Guessed · #2 08-28-2024, 03:58 PM

This compile error is misleading (and has nothing to do with the record count). The actual problem is that you have an If statement inside the For/Next loop that does not close.

Where was this line going to close with an End If?
If Err.Number = 5631 Then

DaniMul · #3 08-28-2024, 06:26 PM

Quote:

Originally Posted by Guessed

This compile error is misleading (and has nothing to do with the record count). The actual problem is that you have an If statement inside the For/Next loop that does not close.

Where was this line going to close with an End If?
If Err.Number = 5631 Then

ok I see I need an End if but where can I put it?

Guessed · #4 08-28-2024, 08:28 PM

What does err.number 5631 mean? Where did you source that code?

I don't have time to work on the nuances of your code so just bring the following line up onto that same line so it says
If Err.Number = 5631 Then Err.Clear

That should allow the code to remove that particular error

DaniMul · #5 08-29-2024, 02:48 PM

I found that part of code when I searched 'runtime error 5631' and found it in another forum somewhere.

This is the error here:

Run time error 5631
Word could not merge the main document with the main data source because the data records were empty or no data records matched your query options.

I adjusted as you advised so the line reads

If Err.Number = 5631 Then Err.Clear

I have re-run the mailmerge macro but this has not fixed the above runtime error popping up.

My macro works fine if there is more than one record, my problem is only if there is just one record it breaks/errors.
For example: If we have a list of 12 records for the day but the word doc I am wanting to save refers to only 1 or 3 entries, if we go into edit recipient list and only tick the ones we need we get that run time error.

If I add a filter to the full list so it only shows the entries we need rather than unticking them it will work BUT only if there are more than 1 entry.

In the meantime I have advised my colleagues if there is one entry just save as a pdf manually.

Guessed · #6 08-29-2024, 03:39 PM

I had another quick look and made a few changes that 'might' happen to work. If this still doesn't do it and you want someone to take a more considered look at the code, attach a merge docx and data source that we can test the code with.

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
      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

DaniMul · #7 08-29-2024, 04:28 PM

Thanks that has stopped the error when there is only one entry/record But it will not complete the last step of saving it as a pdf with the below format

StrName = .DataFields("Property") & " - " & .DataFields("Formated_Date") & " " & .DataFields("Premises_")

I know this is not helpful for either of us but the data I am working with is sensitive information and I am unwilling to provide this as an attachment.

Guessed · #8 08-29-2024, 06:07 PM

Understood. In that case, you need to do the debugging at your end.

If that line is now showing problems then I would guess that one of those fields may not exist in your data source. When you go to debug, hover your mouse over the datafields on that line and see what the popup says.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
supress mail merge error document	vincenzo345	Mail Merge	2	10-10-2017 12:03 PM
Mail Merge Next Record If rule	RHensley	Mail Merge	10	03-07-2017 08:05 AM
avoid duplicete record and merge the record with the existed record	hemant.behere	Excel	0	01-10-2012 02:53 AM
compile error in Word	raco	Word	0	09-28-2010 12:40 PM
Extraneous record in Word Mail Merge	aldo13	Mail Merge	0	01-23-2006 01:58 PM