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@example.com" And _ ToWhom <> "firstname.lastname@example.org" And _ ToWhom <> "email@example.com") _ 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