MailMergeDataSource Find Record function leads to Execute Merge Failure

I am trying to use Visual Basic in Word to automate a MailMergeDataSource document search followed by an executed MailMerge. I have both steps working independently. However, if I call the SearchForDocument() function first, the ExecuteMerge() fails. I receive a Run-time error '5631': Word could not merge the main document with the data source because the data records were empty or no data records matched your query options.

I can run the SearchForDocument() function and note the record number. Then if I close Word and reopen without saving, I can call the ExecuteMerge() on that record number with success.

I have tried resetting the .ActiveRecord to 1 with no luck.

This VB function searches a data source for a matching doc_id, and returns the record number from the dataset. It works with no apparent issues. Returns an accurate record number from the dataset.

Function SearchForDocument(doc_id As String)
    ' Searches datasource for given record id number.
    
    Dim dsMain As MailMergeDataSource
    Dim numRecord As Integer
     
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = False
    Set dsMain = ActiveDocument.MailMerge.DataSource
    'Initializes at first record because .ActiveRecord method only searches for first match in descending records from current record
    dsMain.ActiveRecord = 1
 
    If dsMain.FindRecord(FindText:=doc_id, Field:="SAMPLE") = True Then
        numRecord = dsMain.ActiveRecord
    Else
        MsgBox "Record " & doc_id & " was not found."
        numRecord = 0
    End If
    
    SearchForDocument = numRecord
  
End Function

This function executes a MailMerge from a given record number from a dataset. It works fine unless I run the SearchForDocument function first. When it fails I get run-time error '5631'.

Function ExecuteMerge(ByVal TargetRecord As Integer)    
    Set myMerge = ActiveDocument.MailMerge
    If myMerge.State = wdMainAndSourceAndHeader Or _
     myMerge.State = wdMainAndDataSource Then
     With myMerge.DataSource
     .FirstRecord = TargetRecord
     .LastRecord = TargetRecord
     End With
    End If
    With myMerge
     .Destination = wdSendToNewDocument
     .Execute
     
    End With
   
End Function

Solution

"Word Could Not Merge the Main Document with the Data Source" seems to be a common error without any clear way to fix it.

This function that doesn't use .FindRecord and does not cause ExecuteMerge to fail. I think this is our best alternative, for now.

Function SearchForDocument(doc_id As String, Optional FieldName As String = "Name") As Long
    Dim ds As MailMergeDataSource
    Set ds = ActiveDocument.MailMerge.DataSource
    
    Dim n As Long
    Application.ScreenUpdating = False
    For n = 1 To ds.RecordCount
        ds.ActiveRecord = n
        If ds.DataFields(FieldName).Value = doc_id Then
            SearchForDocument = n
            Exit Function
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Record " & doc_id & " was not found."
End Function

Revised Code Using ADO

This function uses the ActiveDocument.MailMerge.DataSource ConnectString and QueryString to setup an ADO connection. This always us to use recodset.Find as a replacement to the very buggy ActiveDocument.MailMerge.DataSource.FindRecord.

Function GetRowNumber(Value As Variant, FieldName As String) As Variant
    Dim Conn As Object, rs As Object
    Dim DataSource As MailMergeDataSource
    Dim ConnStr As String

    Set DataSource = ActiveDocument.MailMerge.DataSource
    ConnStr = DataSource.ConnectString
    Set Conn = CreateObject("ADODB.Connection")
    Conn.Open ConnStr

    Set rs = CreateObject("ADODB.Recordset")
    rs.CursorLocation = 3
    rs.Open DataSource.QueryString, Conn, 1, 1 'KeySet cursor, Read-Only
    
    rs.MoveFirst
    rs.Find "[" & FieldName & "] = '" & Value & "'"
    If Not rs.EOF Then GetRowNumber = rs.AbsolutePosition
 
    rs.Close:   Set rs = Nothing
    Conn.Close: Set Conn = Nothing
End Function