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.
- 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.
- 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
- 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)
- 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.
- Finally, add the SpamScore field to your columns.
- Right click the column bar
- Select Field Chooser
- Select User-defined fields in
- Drag the field to the desired location in your column bar