Outlook Mails automatisch auf Inhalt prüfen und kategorisieren

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim varEntryIDs
    Dim objItem As Object, strBody As String
    Dim i As Integer
    varEntryIDs = Split(EntryIDCollection, ",")  
    Set regex = CreateObject("vbscript.regexp")  
    regex.IgnoreCase = True
    For i = 0 To UBound(varEntryIDs)
        Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
        If objItem.Class = olMail Then
            Select Case objItem.BodyFormat
                Case olFormatHTML
                    strBody = objItem.HTMLBody
                Case olFormatRichText
                    strBody = objItem.RTFBody
                Case Else
                    strBody = objItem.Body
            End Select
            regex.pattern = "Bugs Bunny"  
            If regex.Test(strBody) Then
                ' Successful match  
                objItem.Categories = "Disney"  
                objItem.Save
            Else
                ' Match attempt failed  
            End If
        End If
    Next
    Set regex = Nothing
End Sub