Extract Email Address from Outlook Mailitem.Body

willknapp

Registered User.
Local time
Today, 12:02
Joined
Aug 16, 2012
Messages
93
Hey folks,

I'm building a help-desk application that converts incoming emails to trouble tickets, scarping various details about the inquiry from the body and subject of the message.

Some of the emails come directly from clients, making identifying the client fairly simple - I simply compare the domain of a message's SenderEmailAddress property to a table of clients and match it up accordingly.

Unfortunately, some of the emails are forwarded by other employees of our company, meaning the SenderEmailAddress will always return "xxx@ourcompany.com" .

As such, I created a rather messy bunch of code that looks for email addresses within the body of the email. First, it searches for "From:" as this is generally the first line of a header block of a forwarded/replied to email. From there, it searches for the "@" then pieces together an email address based on valid characters in front of the "@", valid characters between the "@" and the next "." and the three letters after the ".". (Yes, I know that the length of domain suffixes vary - those that aren't 3 characters are so rare, though, that they'll fall within our acceptable "undertermined" ranges.)

It works, mostly, but it's kind of unwieldy - has anyone else done something like this? I'd be interested in any alternatives. Also, while doing research I stumbled upon a few cool checks, like if the len(emailAddress) < 8, it's likely an invalid email address. Any other nifty little tricks like that I could use? Again, not looking for perfection, but if there are few things I can add to the code that will elminate the bulk of the non-email addresses, it would be very helpful.

Thanks!

Will
 
A forwarded message like that doesn't retain any properties for the original sender, so there is no "easy" fix. Your approach is possibly the only way to achieve this with what you have to hand. However, there are a couple of better ways to handle this. Firstly just get your (lazy) colleagues to include the original senders email in the subject field or as the 1st line of the reply. Another alternative would be to set up an Outlook form for your colleagues to use when forwarding a message and have some VBA insert the original senders email in the subject line.
 
Here's my clunky code. While I am an avid commenter, I'm normally not this thorough; this was done for the sake of lay person who wanted to understand the procedure thoroughly.

Code:
Public Function GetEmail(newMsg As Outlook.MailItem) As String
    ' As some of the inquiries will be created by internal emails that have been forwarded, we want to make
    ' try to get the original non-MyCompany sender email address.  All of the tests follow "most-likely" scenarios.
    ' As our data builds we will be able to tweak the process to get more and more right.
 
    Dim index As Long
    Dim strBody As String
    Dim strEmail As String
    Dim intStart As Integer, intEnd As Integer
 
    If newMsg.SenderEmailType = "EX" Then   ' Mail came from Exchange User
        strEmail = Right(newMsg.SenderEmailAddress, Len(newMsg.SenderEmailAddress) - InStrRev(newMsg.SenderEmailAddress, "=")) & "@MyCompany.com"
    Else
        strEmail = newMsg.SenderEmailAddress
    End If
 
    intEnd = 1   ' I used intEnd as a starting point in the code below for the Instr function.
 
    Do While strEmail Like "*MyCompany.com"
        strBody = newMsg.Body
        ' Search the body of the email for next "@" symbol.
        intStart = InStr(intEnd, strBody, "@")
        If intStart = 0 Then
            ' The "@" symbol was not found.
            ' As of 6/6, we do not have logic for finding the email address in another part of the email, so
            ' we'll designate the client as "undetermined."
            strEmail = "Not Found"
        Else
            ' The "@" symbol was found.  For the next step, we assume the "@" is part of an email address, and
            ' search for the next "."  (We are also assuming that the characters between the "@" and the "." make
            ' up a valid domain.  This can be updated if we still end up with a high number of undetermined clients.)
            ' When found, we'll add 3 to that location (for the domain suffix, which is usually 3 characters)
            ' set that up as the "end" location to be used later for extracting the text.
            intEnd = InStr(intStart, strBody, ".") + 3
            If intEnd > 3 Then
                ' "." was found. Starting with the character prior to the "@" symbol, move back until the first
                ' invalid email address character is found.  This will denote the begining of the address.
                ' intStart will change with each pass through the loop, so we'll know when it stops.
                Do
                    intStart = intStart - 1
                    If Mid(strBody, intStart, 1) = ":" Then Exit Do
                    If Mid(strBody, intStart, 1) = " " Then Exit Do
                    If Mid(strBody, intStart, 1) = ";" Then Exit Do
                    If Mid(strBody, intStart, 1) = "'" Then Exit Do
                Loop
                strEmail = Mid(strBody, intStart + 1, intEnd - intStart)
            Else
                ' No "." was found after the "@" symbol.
                strEmail = "Not Found"
            End If
        End If
    Loop
 
    GetEmail = strEmail
 
Another alternative would be to set up an Outlook form for your colleagues to use when forwarding a message and have some VBA insert the original senders email in the subject line.

Although I've been programming in Access for over 15 years now, this is my first foray into Outlook VBA. The Form thing occurred to me - I need to look into this deeper... Thanks for the tip!
 

Users who are viewing this thread

Back
Top Bottom