Sub CountRecipients()
Dim lngCount As Long, i As Long
Dim oDoc As Document
    If ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument Then
        MsgBox "The active document is not a merge document?", vbCritical
        Exit Sub
    End If
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    Set oDoc = ActiveDocument
    lngCount = oDoc.Sections.Count - 1
    oDoc.Close 0
    MsgBox lngCount
End Sub

Sub listIncluded()
  Dim iLast As Long, iCount As Long
  With ActiveDocument.MailMerge.DataSource
    .ActiveRecord = wdLastRecord
    iLast = .ActiveRecord         '' Store index of the last active record for later use
    .ActiveRecord = wdFirstRecord
    Do
      iCount = iCount + 1
      Debug.Print .ActiveRecord
      DoEvents
      .ActiveRecord = wdNextRecord
    Loop Until .ActiveRecord = iLast
    MsgBox "There are " & iCount & " active records out of " & .RecordCount
  End With
End Sub