Spam Domain Checker for Outlook
A growing percentage of the 2,000+ spams I’m receiving every day come to false names at my domain, evident.com. Here’s a VBA script for Outlook that searches the selected entries in a folder and moves bogus ones sent to that domain into a folder of your choice. To use it, create a folder to receive the putative spam; I’m calling it YOUR_SPAM_FOLDER in the script, but you should change it to whatver yours is called. Also, replace “domain.com” with the domain of your mail, and be sure to specify the addresses to domain.com that you want to accept. (And watch out for bad wraps in the code below.)
Public Sub CheckForBadEvidents()
Dim ToWhom As String
Dim objNS As NameSpace
Dim objInbox As MAPIFolder
Dim objSpamFolder As MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objSpamFolder = objInbox.Folders("YOUR_SPAM_FOLDER")
Dim objApp As Application
Dim objSelection As Selection
Set objApp = CreateObject("Outlook.Application")
Set objSel = objApp.ActiveExplorer.Selection
Dim objItem As Object
' check to make sure the folder is there
If objSpamFolder Is Nothing Then
MsgBox ("Folder not found")
Exit Sub
End If
x = 0 ' count the number of hits, for fun
For Each objItem In objSel
If objItem.Class = 43 Then ' if mail msg
' get the To line
ToWhom = objItem.to
' If it's to evident.com but not
' to a recognized address...
If InStr(ToWhom, "@domain.com") > 0 And _
(ToWhom <> "[email protected]" And _
ToWhom <> "[email protected]" And _
ToWhom <> "[email protected]") _
Then
' move it
objItem.Move objSpamFolder
x = x + 1
End If
End If
Next
MsgBox "Moved to YOUR_SPAM_FOLDER " & x & _
" msgs with ill-formed evident.com addresses."
end Sub
Note: I’m an amateur and you use this script at your own risk. Really. I mean it. (The code for moving a msg to a folder came from here. I’ve lost where I cribbed the other functionality from.
Categories: Uncategorized dw
