Displaying SpamAssassin score in an Outlook field

Feb 14, 2006 13:35

It took me a bit of researching and programming, but I figured out a way to do it.

The most frustrating part of it is that Outlook doesn't provide VBA access to the Internet Headers. Grr!

I don't know how many people might be interested in this, but if you are, my solution is behind the cut.


  1. Because of the limitation described above, you need a third party tool.  I found a developer version of a tool called Redemption. It needs to be installed. :/  At least it is small and not intrusive.
  2. You need to write a VBA sub to do the work (note, if you want to keep your Outlook Macro Security on High, you'll need to sign the macro with a personal signature):

    Sub SetSpamFields(Item As Outlook.MailItem)
        Dim RedemptionUtils
        Dim InternetHeadersField, InternetHeaders
        Dim SpamScore, SpamTests
        Dim StartIdx, EndIdx, FieldLen
        Dim SpamProperty As UserProperty

    Set RedemptionUtils = CreateObject("Redemption.MAPIUtils")

    InternetHeadersField = &H7D001E
        InternetHeaders = RedemptionUtils.HrGetOneProp(Item.MAPIOBJECT, InternetHeadersField)

    StartIdx = InStr(1, InternetHeaders, "X-Spam-Status: hits=", vbTextCompare)
        If StartIdx = 0 Then
            Exit Sub
        Else
            StartIdx = StartIdx + Len("X-Spam-Status: hits=")
        End If
        EndIdx = InStr(StartIdx, InternetHeaders, "tests=", vbTextCompare)
        If EndIdx = 0 Then
            Exit Sub
        Else
            FieldLen = EndIdx - StartIdx
        End If

    SpamScore = Trim(Mid(InternetHeaders, StartIdx, FieldLen))
        Set SpamProperty = Item.UserProperties.Add("SpamScore", olNumber, True)
        SpamProperty.Value = SpamScore

    StartIdx = EndIdx + Len("tests=")
        EndIdx = InStr(StartIdx, InternetHeaders, "version=", vbTextCompare)
        If EndIdx = 0 Then
            Exit Sub
        Else
            FieldLen = EndIdx - StartIdx
        End If

    SpamTests = Mid(InternetHeaders, StartIdx, FieldLen)
        SpamTests = Replace(SpamTests, vbCrLf, "")
        SpamTests = Replace(SpamTests, vbTab, "")
        SpamTests = Trim(SpamTests)
        Set SpamProperty = Item.UserProperties.Add("SpamTests", olText, True)
        SpamProperty.Value = SpamTests

    Item.Save

    Set SpamProperty = Nothing
        Set RedemptionUtils = Nothing
    End Sub

    Sub ManualSetSpamScoresForFolder()
        Dim Folder
        Dim Item As MailItem

    Set Folder = Application.GetNamespace("MAPI").PickFolder
        If Folder Is Nothing Then Exit Sub

    For Each Item In Folder.Items
            SetSpamFields Item
        Next Item
    End Sub

  3. You need a rule that will run the script above:
    Apply this rule after the message arrives
    with X-Spam-Status: in the message header
      and on this machine only (this is added automatically when selecting run a script)
    run Project1.SetSpamFields (a script)


  4. To generate the UserProperties, you need to either run the rule on folders that contain spam tested items or you can run the ManualSetSpamScoresForFolder() sub directly from Macros.
  5. Finally, add the SpamScore field to your columns.
    1. Right click the column bar
    2. Select Field Chooser
    3. Select User-defined fields in
    4. Drag the field to the desired location in your column bar
Previous post Next post
Up