Outlook VBA Script on incoming messages

Question

I have tried to make a script to pick up emails as they come in, reformat them and then forward on to the email in the body but I cannot work out how to read the email body. I currently have:

Sub Confirmation()
myMessage = "You recently made a request on the IT website, the details of your
request can be seen below:" & vbCr & vbCr & "Thank you, " & vbCr & "IT Support"

Dim itmOld As MailItem, itmNew As MailItem

Set itmOld = ActiveInspector.CurrentItem
Set itmNew = itmOld.Forward

itmNew.Body = myMessage & vbCr & vbCr & itmOld.Body
itmNew.Subject = "IT Web Request Confirmation"
itmNew.Display

Set itmOld = Nothing
Set itmNew = Nothing
End Sub

This opens the email adds some text to it and forwards it on.

I would like the script to open the email, read an email address from the body, use that as the to field and reformat the existing email to a nicer format. This is the HTML from the email:

<html><body><br /><br /><table><tr><td><b>Fullname: </b></td><td>Alex Carter</td></tr><tr><td><b>OPS_Access: </b></td><td>Yes</td></tr><tr><td><b>Email_Account_Required: </b></td><td>Yes</td></tr><tr><td><b>Office_Email_Required: </b></td><td>Yes</td></tr><tr><td><b>Website_Access_Required: </b></td><td>Yes</td></tr><tr><td><b>Web_Access_Level: </b></td><td>Staff</td></tr><tr><td><b>Forum_Access_Required: </b></td><td>Yes</td></tr><tr><td><b>Date_Account_Required: </b></td><td>03/08/2013</td></tr><tr><td><b>Requested_By: </b></td><td>Alex Carter</td></tr><tr><td><b>Requestee_Email: </b></td><td>[email protected]</td></tr><tr><td><b>Office_Requesting: </b></td><td>Swindon</td></tr></table></body></html>

This shows that the email to go into the to field is in the 10th row of the table but I am not too sure how to go about selecting this from the body? How would I go about reading the body, reformatting it and then selecting the requestee email and using it as the to field?

Thanks in advance!

Do you have control over the generation of the incoming email? If so, you could make your own tags around the address of interest and search the body for that. — PowerUser

Gaffi Gaffi · Accepted Answer · 2013-03-28T05:16:14

This should help you get started (modifying your code), though you'll have to be more specific with regard to what formatting improvements you would like to see...:

Sub Confirmation()
    myMessage = "You recently made a request on the IT website, the details of your request can be seen below:" & vbCr & vbCr & "Thank you, " & vbCr & "IT Support"
    Dim sAddress As String ' Well need this to store the address
    Dim itmOld As MailItem, itmNew As MailItem

    Set itmOld = ActiveInspector.CurrentItem
    Set itmNew = itmOld.Forward

    sAddress = GetAddressFromMessage(itmOld) ' This is our new function
    If Len(sAddress) > 0 Then
        itmNew.To = sAddress ' If our new function found a value apply it to the To: field.
        '!!! This should be checked as a valid address before continuing !!!
    End If

    itmNew.Body = myMessage & vbCr & vbCr & itmOld.Body
    itmNew.Subject = "IT Web Request Confirmation"
    itmNew.Display

    Set itmOld = Nothing
    Set itmNew = Nothing
End Sub

Private Function GetAddressFromMessage(msg As MailItem) As String
    ' Grabs the email from the standard HTML form described in the SO question.
    Dim lStart As Long
    Dim lStop As Long
    Dim sItemBody As String
    Const sSearchStart As String = "Requestee_Email: </b></td><td>" ' We will look for these tags to determine where the address can be found.
    Const sSearchStop As String = "</td>"

    sItemBody = msg.HTMLBody ' Read the body of the message as HTML to retain TAG info.

    lStart = InStr(sItemBody, sSearchStart) + Len(sSearchStart)
    If lStart > 0 Then ' Make sure we found the first TAG.
        lStop = InStr(lStart, sItemBody, sSearchStop)
    End If

    GetAddressFromMessage = vbNullString

    If lStop > 0 And lStart > 0 Then ' Make sure we really did find a valid field.
        GetAddressFromMessage = Mid(sItemBody, lStart, lStop - lStart)
    End If

End Function

Outlook VBA Script on incoming messages

1 Answers