Macros for custom spam filter?

  • Thread starter Thread starter George Marshall
  • Start date Start date
G

George Marshall

In Outlook 2003, is it possible/feasible to write a macro that runs
after the Rules Filters, and allows me to basically add my own message
filter logic?

If so, does anyone have a model/skeleton macro I could start with?

Thanks,

George Marshall
 
You could write an ItemAdd handler for the Inbox's Items collection
but there is no guarantee when that event handler would fire. It might
be before or after rules or even in the middle of a rule so you would
have to be prepared for errors in your code or the rule that the item
had already been moved or deleted. No way to control the firing order,
so when I do something like that I don't use rules and replace them
completely with code or you can fire a macro from within a rule.

See http://www.slipstick.com/dev/code/zaphtml.htm#cw for an example of
an Inbox ItemAdd handler.
 
Hmm, sounds messy; I was hoping to custom-process only messages that had
made it by my other rules. In the Rules Wizard, there are a couple of
possible actions that seem promising:
"run a script" or "perform a special action"

What is involved in creating code that could be plugged into one of
these?

George
 
Try this macro that I created to automatically add rules for Outlook 2003....

(It can be modified to work with Outlook XP & Outlook 2000. I left the sendkeys
statements for Outlook XP & Outlook 2000 as comments. It's been awhile since
I've used them, so I can't vouch for their accuracy but it will be a start if
you need them. Also, for Outlook XP & Outlook 2000 you many need to use a
different control ID - I was using 721 at one time, but that didn't work with
multiple messages on Outlook 2003.) ....

For the macro to work, you MUST first install 'Outlook Redemption' from
http://www.dimastr.com/redemption/ . This is used to read the actual SMTP
address (without opening the email) instead of just the 'From' field.

It uses 'sendkeys' to add the rules, because from everything I've read, the
rules wizard is not accessible through VB. I know sendkeys can be flakey at
times, but it's been totally effective & reliable for this particular macro. ()

- Select one or multiple messages & run the macro (put a shortcut on the toolbar
for easy access).
- An input box will display a string containing both the IP address & the SMTP
address. You MUST edit this string because it won't filter on anything with the
string as shown. For example: edit it to show "192.168.123." OR ".deals.com"
(both without the quotes of course).
(I used to only filter on part of the address, but I've started filtering on
part of the IP sometimes instead. I took it out for this posting because it
relies on an external executable, but I have it automatically popup the results
of a whois lookup just prior to the input box mentioned above - that way I won't
filter all email from common places like Yahoo, Hotmail, etc based on the IP.)
- The macro stops before finalizing the rule, so you can modify/verify/cancel
it if necessary. If multiple messages were selected, it continues after you add
or cancel the previous rule. (If desired you could add extra sendkeys statements
to fully automate it.)


If anyone's interested I also have a macro that will write all the email info
(unread messages from deleted items - so it gets the spam that was automatically
deleted by rules, but it also gets any other unread messages in deleted items)
into a text file. Then you can import that into a spreadsheet or database and
analyze all that spam.

I also have a macro that will step through the rules wizard & write the filters
to a text file. It uses sendkeys also, but unlike the add macro it is a little
flakey because you can't do anything else while it's running & any events like
receiving email will interrupt it. Plus, it takes a long time to step through
all the rules (if you have hundreds like me). But, it is nice to have a list of
what you're filtering on to be able to sort, find duplicates, etc.

Anyway, try the add macro & let me know how it works....


Sub add()
Dim oOL As Outlook.Application
Dim oSelection As Outlook.Selection
Dim sItem, oItem
Dim vAddress, vParent As String
Dim cbctl As CommandBarButton

crlf = Chr(13) & Chr(10)
Set sItem = CreateObject("Redemption.SafeMailItem")
Set cbctl = Outlook.ActiveExplorer.CommandBars.FindControl(ID:=10012)

Set oOL = New Outlook.Application
Set oSelection = oOL.ActiveExplorer.Selection

For Each obj In oSelection
vParent = obj.Parent
sItem.Item = obj
PrSenderEmail = &HC1F001E
vAddress = sItem.fields(PrSenderEmail)
prHeader = &H7D001E
vHeader = sItem.fields(prHeader)
If InStr(vHeader, "Received: from source ([") Then
vStart = InStr(vHeader, "Received: from source ([") + 24
vEnd = InStr(vStart, vHeader, "])")
vIP = Mid(vHeader, vStart, vEnd - vStart) & " "
ElseIf InStr(vHeader, "Received: from ") Then
vStart = InStr(vHeader, "Received: from ") + 15
vEnd = InStr(vStart, vHeader, " ")
vIP = Mid(vHeader, vStart, vEnd - vStart) & " "
Else
vIP = ""
End If

vAddress = InputBox("Delete messages which include the text below" _
& " in the MESSAGE HEADER." & crlf & "(Note: both the IP & SMTP" _
& " addresses are shown. Edit the text to filter on all/part" _
& " of the IP OR all/part of the SMTP address - the default text" _
& " will never filter anything because it's not a consecutive" _
& " string in the header.)", "The following rule will be created:" _
, vIP & vAddress)
If vAddress = "" Then GoTo Next_Selection

'*****Outlook 2003******
SendKeys "{ENTER}{DOWN}{ENTER}"
SendKeys "{DOWN 14}"
SendKeys "{ }{TAB}{ENTER}"
SendKeys vAddress
SendKeys "{ENTER}{ENTER}{TAB}{TAB}{TAB}{ENTER}"
SendKeys "{DOWN 2}{ }"
SendKeys "{ENTER}{ENTER}"
SendKeys vAddress
SendKeys "{END}{ } -- { }"
SendKeys Now()
SendKeys "{TAB}{ }"
'*****Outlook 2003******

'*****Outlook XP******
'SendKeys "%(n){DOWN}{ENTER}"
'SendKeys "{DOWN 14}"
'SendKeys "{ }{TAB}{ENTER}"
''SendKeys "^(v)"
'SendKeys vAddress
'SendKeys "{ENTER}{ENTER}{TAB}{TAB}{TAB}{TAB}{ENTER}"
'SendKeys "{DOWN 3}{ }"
'SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}"
'SendKeys "{ENTER}{ENTER}{END}"
'SendKeys "{ } -- { }"
'SendKeys Now()
'SendKeys "{TAB}{ }{ENTER}"
'*****Outlook XP******

'*****Outlook 2000******
'SendKeys "%(n){ENTER}"
'SendKeys "{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}"
'SendKeys "{ }{TAB}{ENTER}"
''SendKeys "^(v)"
'SendKeys vAddress
'SendKeys "{ENTER}{TAB}{TAB}{TAB}{TAB}{ENTER}"
'SendKeys "{DOWN}{DOWN}{ }"
'SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}"
'SendKeys "{ENTER}{ENTER}{TAB}{ }{ENTER}"
''DoEvents
''SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}"
''DoEvents
''SendKeys "{TAB}"
''SendKeys "{ENTER}{ENTER}"
'*****Outlook 2000******

cbctl.Execute
DoEvents

Next_Selection:
Next

EXIT_SUB:
Set oSelection = Nothing
Set oOL = Nothing
Set cbctl = Nothing
Set sItem = Nothing
Set Utils = CreateObject("Redemption.MAPIUtils")
Utils.Cleanup
End Sub
 
Back
Top