I assigned myself with a task - I get a bunch of HTML-structured emails with information on Simpana backup jobs - my task was to create a script-based rule in Outlook to focus on those reports that contain information on errors.
Sub BackupJobSummaryReport(olMail As Outlook.MailItem)
Dim mailContent As String
Dim mailHtmlBody As String
Dim allPosition As Integer
Dim completedWithErrors As Integer
Dim completedWithWarnings As Integer
Dim unsuccessful As Integer
Dim tempPos As Integer
Dim objOL As Outlook.Application
Dim ns As Outlook.NameSpace
Dim simpanaErrorFolder As Outlook.Folder
Dim allHtml As String
Dim tdHtml As String
Dim fontEndHtml As String
allHtml = "All</font></td>"
tdHtml = "<td"
fontEndHtml = "</font"
mailHtmlBody = olMail.HTMLBody
mailContent = Replace(mailHtmlBody, Chr(34), "") ' replace e.g. colspan="1" with colspan=1
allPosition = InStr(1, mailContent, allHtml, vbBinaryCompare) ' [A]ll</font></td>
tempPos = InStr(allPosition + Len(allHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..host name..
tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..total..
tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..completed..
tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..completed with errors..
completedWithErrors = CInt(GetValue(Mid(mailContent, tempPos, InStr(tempPos + Len(tdHtml), mailContent, fontEndHtml) - tempPos)))
tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..completed with warnings..
completedWithWarnings = CInt(GetValue(Mid(mailContent, tempPos, InStr(tempPos + Len(tdHtml), mailContent, fontEndHtml) - tempPos)))
tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..killed..
tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..unsuccessful..
unsuccessful = CInt(GetValue(Mid(mailContent, tempPos, InStr(tempPos + Len(tdHtml), mailContent, fontEndHtml) - tempPos)))
If ((completedWithErrors + completedWithWarnings + unsuccessful) > 0) Then
Set objOL = New Outlook.Application
Set ns = Application.GetNamespace("MAPI")
Set simpanaErrorFolder = ns.GetDefaultFolder(olFolderInbox).Folders("Simpana (Errors)")
olMail.Move simpanaErrorFolder
'Else
'MsgBox "No error in any report found!"
End If
End Sub
The script is parsing only the first row of every incoming report. The row includes the summary of all backup jobs performed by Simpana. There's one function that is missing, but it has to do with parsing so I've decided to skip it here. The most important thing here is that I use Office 365 and in newer versions (and by default) Microsoft excluded the 'run a script' option from the list of available actions to take when there's a new message in our mailbox. How to unlock this option? - you can read more HERE
The part associated with parsing is customized since it applies to my workplace, but there are a few interesting lines showing how to move a message to a particular folder inside the Inbox folder. Here is probably the best resource on writing VBA macros I've found so far - VBOFFICE