Video of the week

This is a must-watch video about one of us trying to reach the stars :-)

Well done #HRejterzy

Outlook - Run a Script Rule (VBA)

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.

  1. Sub BackupJobSummaryReport(olMail As Outlook.MailItem)
  2. Dim mailContent As String
  3. Dim mailHtmlBody As String
  4.  
  5. Dim allPosition As Integer
  6. Dim completedWithErrors As Integer
  7. Dim completedWithWarnings As Integer
  8. Dim unsuccessful As Integer
  9. Dim tempPos As Integer
  10.  
  11. Dim objOL As Outlook.Application
  12. Dim ns As Outlook.NameSpace
  13. Dim simpanaErrorFolder As Outlook.Folder
  14.  
  15. Dim allHtml As String
  16. Dim tdHtml As String
  17. Dim fontEndHtml As String
  18.  
  19. allHtml = "All</font></td>"
  20. tdHtml = "<td"
  21. fontEndHtml = "</font"
  22.  
  23. mailHtmlBody = olMail.HTMLBody
  24. mailContent = Replace(mailHtmlBody, Chr(34), "") ' replace e.g. colspan="1" with colspan=1
  25.  
  26. allPosition = InStr(1, mailContent, allHtml, vbBinaryCompare) ' [A]ll</font></td>
  27.  
  28. tempPos = InStr(allPosition + Len(allHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..host name..
  29. tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..total..
  30. tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..completed..
  31. tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..completed with errors..
  32. completedWithErrors = CInt(GetValue(Mid(mailContent, tempPos, InStr(tempPos + Len(tdHtml), mailContent, fontEndHtml) - tempPos)))
  33.  
  34. tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..completed with warnings..
  35. completedWithWarnings = CInt(GetValue(Mid(mailContent, tempPos, InStr(tempPos + Len(tdHtml), mailContent, fontEndHtml) - tempPos)))
  36.  
  37. tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..killed..
  38.  
  39. tempPos = InStr(tempPos + Len(tdHtml), mailContent, tdHtml, vbBinaryCompare) ' go to [<]td ..unsuccessful..
  40. unsuccessful = CInt(GetValue(Mid(mailContent, tempPos, InStr(tempPos + Len(tdHtml), mailContent, fontEndHtml) - tempPos)))
  41.  
  42. If ((completedWithErrors + completedWithWarnings + unsuccessful) > 0) Then
  43. Set objOL = New Outlook.Application
  44. Set ns = Application.GetNamespace("MAPI")
  45. Set simpanaErrorFolder = ns.GetDefaultFolder(olFolderInbox).Folders("Simpana (Errors)")
  46. olMail.Move simpanaErrorFolder
  47. 'Else
  48. 'MsgBox "No error in any report found!"
  49. End If
  50. 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