Mail Merge - Dynamic subject line?

[Shrederino]

I recently ran into a situation where i needed this functionality, so i used the already existing code here and polished it up a bit. It handles multiple merge fields in the subject line as well, and i am running it on O365 so it should work with the latest office versions.

How to get it to work (for dummies):

1. Enable developer tab in Word, open up Visual Basic with the button on the Developer tab
2. In the Microsoft Word Objects there is a ThisDocument object. Double-click on that.
3. A code editor should appear on the right side of the window. Paste the below code in there. You can delete everything else if there is anything in there already.
4. Open the Debug menu up top in the Visual Basic window and click on Compile Project
5. Save and close your Word document.
6. Upon reopening the document again, the MailMerge Wizard should show up on the right side of the Word window. Complete the MailMerge with the Wizard! This is important! The macro only works if you complete MailMerge this way.

Public WithEvents wdapp As Word.Application

Dim ORIG_EMAIL_SUBJECT As String
Dim FIRST_RECORD As Boolean

'Open MailMerge Wizard when document is opened
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)
    'Called once per record (row in spreadsheet).
    
    Dim i As Integer
        
    With ActiveDocument.MailMerge
        
        'Get or reset the .MailSubject MailMerge property
        If FIRST_RECORD = True Then
            ORIG_EMAIL_SUBJECT = .MailSubject
            FIRST_RECORD = False 'Set the flag so it won't change the ORIG_EMAIL_SUBJECT anymore
            
        Else:
            .MailSubject = ORIG_EMAIL_SUBJECT 'Reset from customized .MailSubject back to original for next mailmerge iteration
                      
        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)

    'Initialize for first use
    FIRST_RECORD = True
    
End Sub

Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)

    'Reset back to original when done.
    ActiveDocument.MailMerge.MailSubject = ORIG_EMAIL_SUBJECT
    
End Sub

Sources:
wickahead's code
hutchinsfairy's code
Both can be found in this thread, i can't do links.

I didn't do extensive debugging and i am also not a programmer, so your mileage may vary. I hope it helps.