vba - Search structured text in Outlook body

Question

I need to find a line in a selected mail and copy it.

The line contains

Mailbox: ????????????????

The number of symbols in that line are different

The mail looks somewhat like this

Mailbox Details
==============================================================================
Mailbox:          /xxxxxx/xxxxxxxxxx/xxxxxxxxx
Message Name:     xxxxxxxxxxxxxxxxxxxxxxxxx
Message Id:       xxxxxxxxxxxxxxx
==============================================================================

The copied line should go into the subject of a new mail created by the code.

All I am missing is how to copy the line into the subject.

Sub SterlingForward()    
    Set objItem = ForwardB()
    Set objItem = ForwardA()
End Sub


Function ForwardA() As Object
    Dim oAccount As Outlook.Account
    Dim initialSubj, finalSubj As String
    Dim oMail As Outlook.MailItem
    Set oMail = Application.ActiveExplorer.Selection(1).Reply
    oMail.SentOnBehalfOfName = "[email protected]"
    oMail.To = "[email protected]"
    oMail.Display

    Set myitem = Application.ActiveInspector.CurrentItem
    initialSubj = myitem.Subject
    initialBod = myitem.Body

    finalSubj = ??????????????????????

    finalBody = "Hello Team," + vbCrLf + "resend was successful" + vbCrLf & CStr(initialBod)
    myitem.Subject = finalSubj
    myitem.Body = finalBody
End Function


Function ForwardB() As Object
    Dim objMail As Outlook.MailItem
    Dim initialSubj, initialBod, finalSubj, finalBody As String
    Set objItem = GetCurrentItem()
    Set objMail = objItem.Forward
    objMail.To = "[email protected]"
    objMail.Display
    Set objItem = Nothing
    Set objMail = Nothing

    Set myitem = Application.ActiveInspector.CurrentItem
    initialSubj = myitem.Subject
    initialBod = myitem.Body

    finalSubj = ????????????????????????????

    finalBody = "Hello Team," + vbCrLf + "resend was successful" + vbCrLf & CStr(initialBod)
    myitem.Subject = finalSubj
    myitem.Body = finalBody
End Function


Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
    Case "Explorer"
    Set GetCurrentItem = _
    objApp.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
    Set GetCurrentItem = _
    objApp.ActiveInspector.CurrentItem
    Case Else
    End Select
End Function

Answer 1

finalSubj = ParseTextLinePair(initialBod, "Mailbox:")

See "Listing 17.1. Extract data from a structured text block". https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2007/dd492012(v=office.12)

Function ParseTextLinePair(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String

' locate the label in the source text
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

Note: The OP indicated the line that worked was

finalSubj = ParseTextLinePair((CStr(initialBod)), "Mailbox:")