Outlooks Spam Handler

The spam filters that we use at work, process all the messages in a particular folder to train the filter. Rather than drag and drop messages, I use the following code to move the selected or active message into the target folder. For each of the public subs, I have a toolbar button which runs the code.

' Copyright under GPL by Mark Grimes

' Move selected mail to spam training folder
Public Sub Spam()
    Dim objSelection    As Variant
    Dim objDestFolder   As MAPIFolder

    Debug.Print "MoveToSpam..."

    Set objSelection = GetSelection
    Set objDestFolder = GetFolder("This is spam email")
    ProcessMessages objSelection, objDestFolder, True

    Debug.Print "Done"
End Sub

' Move selected mail to ham training folder
Public Sub Ham()
    Dim objSelection    As Variant
    Dim objDestFolder   As MAPIFolder

    Debug.Print "CopyToHam..."

    Set objSelection = GetSelection
    Set objDestFolder = GetFolder("This is legitimate email")
    ProcessMessages objSelection, objDestFolder, False

    Debug.Print "Done"
End Sub

' Move selected mail to whilelist training folder
Public Sub Whitelist()
    Dim objSelection    As Variant
    Dim objDestFolder   As MAPIFolder

    Debug.Print "Whitelist..."

    Set objSelection = GetSelection
    Set objDestFolder = GetFolder("Add to whitelist")
    ProcessMessages objSelection, objDestFolder, False

    Debug.Print "Done"
End Sub

' Return a collection which holds all the selected emails
Private Function GetSelection()
    Dim objApp, objSelection

    Set objApp = CreateObject("Outlook.Application")
    Set objSelection = objApp.ActiveExplorer.Selection
    Debug.Print "  got " & objSelection.Count & " items"

    Set GetSelection = objSelection
End Function

' Return the folder which we will move mail to
Private Function GetFolder(folder As String)
    Dim objNS           As NameSpace
    Dim objDestFolder   As MAPIFolder

    Set objNS = Application.GetNamespace("MAPI")
    Set objDestFolder = objNS.Folders.Item("Public Folders").Folders.Item("All Public Folders").Folders.Item("GFI AntiSpam Folders").Folders.Item(folder)
    Set GetFolder = objDestFolder
End Function

' Move or copy all the messages in the collection into the designated folder
Private Sub ProcessMessages(objSelection As Variant, objDestFolder As MAPIFolder, move As Boolean)
    Dim myItem As Object
    Dim myCopiedItem As Object

    For Each myItem In objSelection
        If Not (TypeOf myItem Is MailItem) Then
            Debug.Print "  item is not an email"
        Else
            If move Then
                Debug.Print "  moving item"
                myItem.move objDestFolder
            Else
                Debug.Print "  copying item"
                Set myCopiedItem = myItem.Copy
                myCopiedItem.move objDestFolder
            End If
        End If
    Next
End Sub

' Move current email to Spam folder
' Called from an open email rather than the list
Public Sub ThisIsSpam()
    Dim objSelection    As Variant
    Dim objDestFolder   As MAPIFolder

    Debug.Print "MoveToSpam..."

    Set objSelection = GetCurrentItem
    Set objDestFolder = GetFolder("This is spam email")
    ProcessMessages objSelection, objDestFolder, True

    Debug.Print "Done"
End Sub

' Return the current email as the sole member of a collection
Private Function GetCurrentItem()
    Dim objApp, objSelection, objItem

    Set objApp = CreateObject("Outlook.Application")
    Set objItem = objApp.ActiveInspector.CurrentItem
    Set objSelection = New Collection
    objSelection.Add objItem
    Debug.Print "  got " & objSelection.Count & " items"

    Set GetCurrentItem = objSelection
End Function