Loop through selected emails and display the first name on each email

If I select 4 emails in outlook and run the code below, it should create 4 new emails that has different first name on the email body. But the code only gets the first name on Email 1 and also displays it to the 2nd to 4th.

Example:

Email 1: First Name Person1
Email 2: First Name Person2
Email 3: First Name Person3
Email 4: First Name Person4

The generated email result should be:

Email 1: Person1
Email 2: Person2
Email 3: Person3
Email 4: Person4

Sub FindName()

Dim olMail As Outlook.MailItem
Dim Selection As Selection
Dim obj As Object
Set olMail = Application.ActiveExplorer().Selection(1)
Set Selection = Application.ActiveExplorer.Selection


For Each obj In Selection
    Set objMsg = Application.CreateItem(olMailItem)

    Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection, FName As String
    rxp4.pattern = "First Name\s*(\s*(\w.*\b))"
    rxp4.Global = True
    
    Set c4 = rxp4.Execute(olMail.Body)
    
    For Each m4 In c4
        FName = m4.SubMatches(0) + " "
    Next
    

    '--------------------------
    With objMsg
        .To = "[email protected]"
        .Subject = obj.Subject
        '.Body = obj.Body
        .HTMLBody = _
        "<HTML><BODY>" & _
        "<div style='font-size:10pt;font-family:Verdana'>" & _
        "<table style='font-size:10pt;font-family:Verdana'>" & _
        "<tbody>" & _
        "<tr class='blue'><td>" + FName & "</td></tr>" & _
        "<tbody>" & _
        "</table>" & _
        "</div>" & _
        "</BODY></HTML>"
        
        .Display
        
    End With
    
    '---------------------------
Next

End Sub

Solution

Partial answer - I'm not familiar with RegEx but some changes I'd make in first half of your code

Sub FindName()
   Dim olMail As Outlook.MailItem
   Dim Selection As Selection
   Dim obj As Object
   
   ' Added or moved the following
     Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection, FName As String
     Dim Ptr As Integer
   ' End of Additions
   
   'Set olMail = Application.ActiveExplorer().Selection(1)
   Set Selection = Application.ActiveExplorer.Selection
   
   For Each obj In Selection
      ' Added the following
        Ptr = Ptr + 1
        Set olMail = Application.ActiveExplorer().Selection(Ptr)
      ' End of Aadditions
      Set objMsg = Application.CreateItem(olMailItem)
      'Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection, FName As String
      rxp4.Pattern = "First Name\s*(\s*(\w.*\b))"
      rxp4.Global = True