Extract data from emails and add to csv

I need to take some details from emails as they're received and add them to a csv file.
I think the best approach is to assign a script to an Outlook rule.
Please can someone assist me with this?

The email layout will always be the same, but the content will differ.
I need to extract the name from the 'To' address of the email and the 'Employee' and 'Reason' from the html table included in the body of the email...
<table cellpadding="3" cellspacing="0" class="bm-data" width="100%">
<thead>
<th align="left">Employee</th>
<th align="left">Date</th>
<th align="left">Type</th>
<th align="left">Reason</th>
</thead>
<tbody>
<tr>
<td>Joe  <strong>Bloggs</strong></td>
<td>21/04/2015, 9:13am</td>
<td>Went the extra mile</td>
<td>Fast response on IT issue, contacted me at 21:30 - going the extra mile! Cheers!</td>
</tr>
</tbody>
</table>

Open in new window


Many thanks in advance!
antoniokingAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

omgangIT ManagerCommented:
To test with, I created a template in Outlook (stationery) using the html you provided above.  As you might expect Outlook added a bunch of additional markup to the message html though.  Still I believe the procedures do what you ask.  You may need to tweak it a bit.  I'm not including the parts to output to the csv file.  Let me know if you need assistance with that as well.
OM Gang

Public Sub WriteMsgDataToFile()
On Error GoTo Err_WriteMsgDataToFile

    Dim olApp As Outlook.Application
    Dim olMsgItem As Outlook.MAILITEM
    Dim strId As String
    
    Set olApp = Application
    
        'gets currently selected message item in Outlook window
    For Each olMsgItem In olApp.ActiveExplorer.Selection
        strId = ""
            'here you can retrieve the various bits of the email message.  the Sender is the name (not email address) if resolved
        'Debug.Print olMsgItem.Sender
        'Debug.Print olMsgItem.Subject
        'Debug.Print olMsgItem.HTMLBody
        
            'call to function to parse the html message body and return the section you're looking for
        strId = GetStringFromHTMLTableCell(olMsgItem.HTMLBody)
        Debug.Print strId

    Next

Exit_WriteMsgDataToFile:
    Set olMsgItem = Nothing
    Set olApp = Nothing
    Exit Sub
    
Err_WriteMsgDataToFile:
    MsgBox Err.Number & ", " & Err.Description, , "Error in procedure WriteMsgDataToFile"
    Resume Exit_WriteMsgDataToFile
    
End Sub


Public Function GetStringFromHTMLTableCell(strBody As String) As String
On Error GoTo Err_GetStringFromHTMLTableCell

    Dim strSearchString As String, strSearchString2 As String, strReturn As String
    Dim lngPosition As Long, lngPosition2 As Long
    
        'strings we're looking for in message body.  because Outlook added additional markup in my test I'm only looking for the first three characters of the table cell tag
    strSearchString = "<td"
    strSearchString2 = "</td>"
    
        'find the search string in the message body
        'note we're using the In String Reverse function so we begin our search from the end of the string (because we're looking for the last table cell tag in the table)
    lngPosition = InStrRev(strBody, strSearchString)
    lngPosition2 = InStrRev(strBody, strSearchString2)
    
        'now that we have the positions of the opening and closing table cell tags we can get the string part in between
    strReturn = Mid(strBody, lngPosition, lngPosition2 - lngPosition)
    
Exit_GetStringFromHTMLTableCell:
    GetStringFromHTMLTableCell = strReturn
    Exit Function
    
Err_GetStringFromHTMLTableCell:
    MsgBox Err.Number & ", " & Err.Description, , "Error in function GetStringFromHTMLTableCell"
    Resume Exit_GetStringFromHTMLTableCell

End Function

Open in new window

antoniokingAuthor Commented:
Thanks OM Gang
The code you have supplied will return the value of the first cell of the table which is the 'employee' value
What about the 'Reason' and the name from the email's to address?
omgangIT ManagerCommented:
Sorry, missed the part about getting the employee.  The code above does retrieve the Reason though (it retrieves the LAST cell in the table).  In your original Q you asked for the name from the To address.  The Debug.Print olMsgItem.Sender retrieves the senders name if it can resolve it, e.g. in my environment working off of a corporate Exchange server it returns 'Gang, OM'.  If you want the email address instead us olMsgItem.SenderEmailAddress.

I'll add code to retrieve the employee as well.
OM Gang
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

antoniokingAuthor Commented:
Thank you very much OM Gang!
omgangIT ManagerCommented:
Please try these.  I created a vbscript to send myself an email message with your exact html as posted in your original Q so I'm not having to deal with the additional markup Outlook adds to the html template (stationery).  This gets what you want.

Here's the output from the Debug.Print statements
Fast response on IT issue, contacted me at 21:30 - going the extra mile! Cheers!
Joe  <strong>Bloggs</strong>

OM Gang


Public Sub WriteMsgDataToFile()
On Error GoTo Err_WriteMsgDataToFile

    Dim olApp As Outlook.Application
    Dim olMsgItem As Outlook.MAILITEM
    Dim strReason As String, strEmployee As String
    
    Set olApp = Application
    
    For Each olMsgItem In olApp.ActiveExplorer.Selection

        'Debug.Print olMsgItem.Sender
        'Debug.Print olMsgItem.Subject
        'Debug.Print olMsgItem.HTMLBody
        
        strReason = ""
        strReason = GetReasonFromHTMLTableCell(olMsgItem.HTMLBody)
        Debug.Print strReason
        
        strEmployee = ""
        strEmployee = GetEmployeeFromHTMLTableCell(olMsgItem.HTMLBody)
        Debug.Print strEmployee
        
    Next

Exit_WriteMsgDataToFile:
    Set olMsgItem = Nothing
    Set olApp = Nothing
    Exit Sub
    
Err_WriteMsgDataToFile:
    MsgBox Err.Number & ", " & Err.Description, , "Error in procedure WriteMsgDataToFile"
    Resume Exit_WriteMsgDataToFile
    
End Sub

Public Function GetReasonFromHTMLTableCell(strBody As String) As String
On Error GoTo Err_GetReasonFromHTMLTableCell

    Dim strSearchString As String, strSearchString2 As String, strReturn As String
    Dim lngPosition As Long, lngPosition2 As Long
    
        'string we're looking for in message body
    strSearchString = "<td>"
    strSearchString2 = "</td>"
    
        'find the search string in the message body
    lngPosition = InStrRev(strBody, strSearchString) + 4
    lngPosition2 = InStrRev(strBody, strSearchString2)
    
    strReturn = Mid(strBody, lngPosition, lngPosition2 - lngPosition)
    
Exit_GetReasonFromHTMLTableCell:
    GetReasonFromHTMLTableCell = strReturn
    Exit Function
    
Err_GetReasonFromHTMLTableCell:
    MsgBox Err.Number & ", " & Err.Description, , "Error in function GetReasonFromHTMLTableCell"
    Resume Exit_GetReasonFromHTMLTableCell

End Function

Public Function GetEmployeeFromHTMLTableCell(strBody As String) As String
On Error GoTo Err_GetEmployeeFromHTMLTableCell

    Dim strSearchString As String, strSearchString2 As String, strReturn As String
    Dim lngPosition As Long, lngPosition2 As Long
    
        'string we're looking for in message body
    strSearchString = "<td>"
    strSearchString2 = "</td>"
    
        'find the search string in the message body
    lngPosition = InStr(strBody, strSearchString) + 4
    lngPosition2 = InStr(strBody, strSearchString2)
    
    strReturn = Mid(strBody, lngPosition, lngPosition2 - lngPosition)
    
Exit_GetEmployeeFromHTMLTableCell:
    GetEmployeeFromHTMLTableCell = strReturn
    Exit Function
    
Err_GetEmployeeFromHTMLTableCell:
    MsgBox Err.Number & ", " & Err.Description, , "Error in function GetEmployeeFromHTMLTableCell"
    Resume Exit_GetEmployeeFromHTMLTableCell

End Function

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Martin LissOlder than dirtCommented:
I've requested that this question be closed as follows:

Accepted answer: 500 points for omgang's comment #a40738281

for the following reason:

This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
antoniokingAuthor Commented:
Thanks
Apologies for delay in awarding points!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.