How do I copy an e-mail address from an outlook e-mail body and insert it into the recipient field of a new e-mail? - vba

Question

Every day I receive several automated e-mails which contain some information that needs to be forwarded to another e-mail address(es).
This e-mail address is in the automated e-mail, and will not always be the same. This e-mail address is located in a table, under the row labeled "Remarks". I've inserted a picture to illustrate this.
I would like to automate this process using Outlook VBA Macros. Some additional information:
1) I cannot use the "run a script" function under Rules.
2) The incoming e-mails are automated and will always be the same format.
What I need help is in:
1) Copying the e-mail address in the next column of the "remarks" row.
I have already managed to automate the process of recognizing the incoming e-mail (by its subject title) and auto-forwarding it to a predefined e-mail address and changing the forwarded email subject title.
Private WithEvents Items as Outlook.Items
Private Sub application_startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNameSpace("MAPI")
'Setting target folder as inbox
Set Items = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.Mailitem
'act only if it is a mail item
If TypeName(Item) = "MailItem" Then
Set Msg = Item
'Detect emails with specified subject title
If Msg.Subject = "Test" Then
Set myForward = Item.Forward
myForward.Recipients.Add("test#gmail.com")
myForward.Subject = "FW: Success"
myForward.Save
myForward.Send
EndIf
EndIf
ProgramExit: Exit Sub
ErrorHandler:
MsgBox Err.Number & "-" & Err.Description
Resume ProgramExit
End Sub

Answer 1

According to my understand, You want to get address in email body.
You could use the below code:
Option Explicit
Sub Example()
Dim Item As MailItem
Dim RegExp As Object
Dim Search_Email As String
Dim Pattern As String
Dim Matches As Variant
Dim len1 As String
Dim result As String
Set RegExp = CreateObject("VbScript.RegExp")
Pattern = "remarks\s+(\b[A-Z0-9._%+-]+\b)"
For Each Item In ActiveExplorer.Selection
Search_Email = Item.Body
With RegExp
.Global = False
.Pattern = Pattern
.IgnoreCase = True
Set Matches = .Execute(Search_Email)
End With
If Matches.Count > 0 Then
len1 = Matches(0).Length() - 8
result = Mid(Matches(0), 12, len1)
result = result + "#gmail.com"
MsgBox result
Debug.Print Matches(0)
Else
Debug.Print "Not Found "
End If
Next
Set RegExp = Nothing
End Sub
For more information, you could refer to this link:
Extract Email address from a table in .HTMLbody