Dim WithEvents wdapp As Application
Dim EMAIL_SUBJECT As String
Dim FIRST_RECORD As Boolean


Private Sub Document_Open()
    Set wdapp = Application
    ThisDocument.MailMerge.ShowWizard 1   
End Sub

Private Sub Document_Close()
    Set wdapp = Nothing    
End Sub


Private Sub wdapp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean)
    Dim i As Integer    
    With ActiveDocument.MailMerge    
        If FIRST_RECORD = True Then 
            EMAIL_SUBJECT = .MailSubject
            FIRST_RECORD = False
        Else .MailSubject = EMAIL_SUBJECT
        End If
        i = .DataSource.DataFields.Count        
        Do While i > 0
            .MailSubject = Replace(.MailSubject, "<" & .DataSource.DataFields(i).Name & ">", .DataSource.DataFields(i).Value, , , vbTextCompare)
            i = i - 1
        Loop
    End With      
End Sub


Private Sub wdapp_MailMergeBeforeMerge(ByVal Doc As Document, ByVal StartRecord As Long, ByVal EndRecord As Long, Cancel As Boolean)
    FIRST_RECORD = True    
End Sub

Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)
    ActiveDocument.MailMerge.MailSubject = EMAIL_SUBJECT     
End Sub

Sub Timed_Email_Merge()
' Merges one record at a time to email with a pre-defined delay between messages.
' Sourced from: https://www.msofficeforums.com/mail-...rge-delay.html
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.MailMerge
  .Destination = wdSendToEmail
  .MailAddressFieldName = "Email"
  .MailSubject = "Subject"
  .SuppressBlankLines = True
  For i = 1 To .DataSource.RecordCount
    With .DataSource
      .FirstRecord = i
      .LastRecord = i
      .ActiveRecord = i
    End With
  .Execute Pause:=False
  Call Pause(10)
  Next i
End With
Application.ScreenUpdating = True
End Sub

Public Function Pause(Delay As Long)
Dim Start As Long
Start = Timer
If Start + Delay > 86399 Then
  Start = 0: Delay = (Start + Delay) Mod 86400
  Do While Timer > 1
    DoEvents ' Yield to other processes.
  Loop
End If
Do While Timer < Start + Delay
  DoEvents ' Yield to other processes.
Loop
End Function