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
