See Chapter 17: Working with Item Bodies https://msdn.microsoft.com/en-us/lib...ffice.12).aspx


Sub ForwardToAddr()

    Dim objOL As Outlook.Application
    Dim objItem As Object
    Dim objFwd As Outlook.MailItem
    Dim strAddr As String
    
    Set objOL = Application
    
    On Error Resume Next
    ' open the item to be sure it is what you want
    Set objItem = objOL.ActiveInspector.currentItem

    ' otherwise you can use the method in the link
    ' and select a mailitem Set objItem = objOL.ActiveExplorer.Selection(1)
    
    On Error GoTo 0
    
    If Not objItem Is Nothing Then
    
        If objItem.Class = olMail Then
        
            Set objFwd = objItem.Forward
            objFwd.To = "anotheraddress @ somewhere.com"
            objFwd.Subject = ParseTextLinePair(objItem.body, "5.tour_booked :") & _
                       " " & ParseTextLinePair(objItem.body, "5.tour_price :")
            objFwd.Display
            
        Else
            MsgBox "Open a mailitem", , "ForwardToAddr"
            
        End If
        
    Else
        MsgBox "Open a mailitem", , "ForwardToAddr"
                
    End If
    
    Set objOL = Nothing
    Set objItem = Nothing
    Set objFwd = Nothing
    
End Sub
If you do not mean to forward ""there doesnt need to be anything in the body of the email."

Sub SendToAddr()

    Dim objOL As Outlook.Application
    Dim objItem As Object
    Dim objNewMail As Outlook.MailItem
    Dim strAddr As String
    
    Set objOL = Application
    
    On Error Resume Next
    ' open the item to be sure it is what you want
    Set objItem = objOL.ActiveInspector.currentItem
    On Error GoTo 0
    
    If Not objItem Is Nothing Then
    
        If objItem.Class = olMail Then
        
            Set objNewMail = CreateItem(olMailItem)
            objNewMail.To = anotheraddress @ somewhere.com"
            objNewMail.Subject = ParseTextLinePair(objItem.body, "5.tour_booked :") & _
                     " " & ParseTextLinePair(objItem.body, "5.tour_price :")
            objNewMail.Display
            
        Else
            MsgBox "Open a mailitem", , "SendToAddr"
            
        End If
        
    Else
        MsgBox "Open a mailitem", , "SendToAddr"
                
    End If
        
    Set objOL = Nothing
    Set objItem = Nothing
    Set objNewMail = Nothing
    
End Sub
The important part provided at the link.

Function ParseTextLinePair(strSource As String, strLabel As String)

    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer
    Dim intLenLabel As Integer
    Dim strText As String
    
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)
    
    If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
        
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, intLocLabel, intLocCRLF - intLocLabel)
        Else
            intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
        End If
        
    End If
    
    ParseTextLinePair = Trim(strText)

End Function