Display Spamassassin Scores in Outlook

[sensei256]

Most of the mail servers I work with run SpamAssassin. It's one of the most powerful and flexible systems out there. I'd probably be dead with out it.

I use Outlook as my mail client. I wanted something to extract the SpamAssassin scores and information from the headers and put that into a custom column, or at least a separate field. Various Google searches were fruitless, except for an old post from LJ user daniele

It is possible to do this with a VBA macro. It took an hour to debug and a few minutes to install on my other machines.
If you understand how to add macros to Outlook, read on:


This Script is for SpamAssassin 3.2.5. It will probably work for most 3.2 versions, depending on the order of the fields in X-Spam-Status.

This assumes that "score" is between "score=" and "required=" and "tests" are between "tests=" and "autolearn=". You will need to adjust these values if this isn't true for your system.

Essentially, you want to get a MailItem, get its Header fields, and walk through the results.

The score and the tests are extracts and put into separate "fields" in the MailItem.

You can then add these two user-defined fields into your current outlook view. The information will automatically display.

Sub SetSpamFields(Item As Outlook.MailItem)
Dim InternetHeaders

Dim HasHeader

Dim SpamScore, SpamTests
Dim StartIdx, EndIdx, FieldLen
Dim SpamProperty As UserProperty

Dim oPropAccessor As Outlook.PropertyAccessor

Const PR_MAIL_HEADER_TAG = _
"http://schemas.microsoft.com/mapi/proptag/0x007D001E"

'only works if Application.IsTrusted is True
Set oPropAccessor = Item.PropertyAccessor

InternetHeaders = oPropAccessor.GetProperty(PR_MAIL_HEADER_TAG)

StartIdx = InStr(1, InternetHeaders, "X-Spam-Status: ", vbTextCompare)
If StartIdx = 0 Then
Exit Sub
End If

StartIdx = StartIdx + Len("X-Spam-Status: ")
HasHeader = 0

StartIdx = InStr(StartIdx, InternetHeaders, "score=", vbTextCompare)
If StartIdx <> 0 Then
StartIdx = StartIdx + Len("score=")

EndIdx = InStr(StartIdx, InternetHeaders, "required=", vbTextCompare)
If EndIdx <> 0 Then
FieldLen = EndIdx - StartIdx
HasHeader = 1
End If
End If

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

HasHeader = 0
StartIdx = InStr(StartIdx, InternetHeaders, "tests=", vbTextCompare)
If StartIdx <> 0 Then
StartIdx = StartIdx + Len("tests=")

EndIdx = InStr(StartIdx, InternetHeaders, "autolearn=", vbTextCompare)
If EndIdx <> 0 Then
FieldLen = EndIdx - StartIdx
HasHeader = 1
End If
End If

If HasHeader = 1 Then
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
End If

Item.Save

Set SpamProperty = 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

This should be consider a starting point; obviously, you'll need to adapt this for your local settings.
Special thanks to http://daniele.livejournal.com/65985.html and http://www.pcreview.co.uk/forums/thread-2635914.php

(note: comments are screened for non-friends. I probably won't be able to assist people who have problems setting this up. Sorry)