A reader named Mohammed Syed asked if I could put together a script to parse information from messages he receives containing hail reports, and write it to a spreadsheet. Each message body contains one or more reports that look like this
1.00″ reported @ 04/10/2013 15:10 CST IL, BRIGHTON – Zip Code: 62012 Zip Pop: 6261 Zip Homes: 2517 County: MACOUPIN Remarks: DELAYED REPORT. NEAR THE INTERSECTION OF MACCOUPIN… JERSEY… AND MADISON COUNTIES.
For each report, Mohammed wants to extract the date/time of the report, the number of inches, and the zip code the report came from. Next, he needs the solution to create a report ID consisting of the alert date/time, the number of inches, and the zip code. The ID will be a concatenation of the elements with each element separated by an underscore. Mohammed wants the data written to an existing spreadsheet with a new row for each report. Finally, he wants to be able to do this from an Outlook rule he already has.
Here’s my solution. Hopefully this is just what Mohammed is looking for.
Follow these instructions to add the code to Outlook.
- Start Outlook
- Press + to open the Visual Basic Editor
- If not already expanded, expand Microsoft Office Outlook Objects
- If not already expanded, expand Modules
- Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert → Module.
- Copy the code from the code snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
- Click the diskette icon on the toolbar to save the changes
- Close the VB Editor
Sub ParseHailMessage(olkMsg As Outlook.MailItem) 'Create some constants 'On the next line edit the path and name of the spreadsheet the data will go in Const WORKBOOK_PATH = "C:\SomeFilename.xlsx" 'Create some variables Dim excApp As Object, excWkb As Object, excWks As Object Dim arrLines As Variant, varLine As Variant Dim strAlertID As String, strAlertTime As String, strInches As String, strZip As String Dim lngRow As Long 'Connect to Excel Set excApp = CreateObject("Excel.Application") Set excWkb = excApp.Workbooks.Open(WORKBOOK_PATH) Set excWks = excWkb.Worksheets(1) 'Get the last row in the worksheet lngRow = excWks.UsedRange.Rows.Count + 1 'Split the body of the message into an array of lines arrLines = Split(olkMsg.Body, vbCrLf) 'Read each line For Each varLine In arrLines 'If the line is blank, then we must be entering a new report block (i.e. group of 4 lines) If varLine = "" Then 'Write the last report block to the spreadsheet With excWks .Cells(lngRow, 1) = strAlertID .Cells(lngRow, 2) = strAlertTime .Cells(lngRow, 3) = strInches .Cells(lngRow, 4) = strZip End With 'Increment the row counter lngRow = lngRow + 1 'Initialize relevant variables for a new report strAlertID = "" strAlertTime = "" strInches = "" strZip = "" Else 'Is this the first line of a report block? If InStr(1, varLine, "reported @") > 0 Then strInches = Left(varLine, InStr(1, varLine, "reported @") - 3) strAlertTime = Mid(varLine, InStr(1, varLine, "@") + 2, 16) Else 'Is this the second line of a report block? If InStr(1, varLine, "Zip Code:") > 0 Then strZip = Mid(varLine, InStr(1, varLine, "Zip Code:") + 10, 5) strAlertID = strAlertTime & "_" & strInches & "_" & strZip End If End If End If Next 'Save the spreadsheet and exit Excel excWkb.Close True 'Disconnect from Excel Set excWks = Nothing Set excWkb = Nothing Set excWks = Nothing End Sub
Once Mohammed has added the code to Outlook, he will need to edit his rule and add a new action, run a script, to it. He’ll set ParseHailMessage as the script to run.