A
Atlas
I'm trying to set a antispam policy, so I wrote a few rules with the RW in
OL2002.
As I've set a white list approach, when unknown mail is received a reply is
sent with a message saying that the sender isn't my address book, and a few
instructions on how to bypass filtering (for friends that may have changed
email addresses, and so on). This obviuosly causes many bounce back mails
with "undeliverable".
So in the RW the first rule is VBA script that checks everywhere in the
incoming message if it is a bounce back message and if so it deletes it.
The complete RW antispam policy is:
1) Run VBA script: check bounce back, if so delete message
2) Check if mail subject contains bypass string, if so stop processibg more
rules
3) Check if sender is in address book, if not move to spam and stop
processing more rules.
4........other rules
Two problems:
1) "Rules in error - The operation failed. An object could not be found." -
Looks like some messages are malformed (headers, mime, dunno what else) so
the script many times fails. Looks like somebodyelse had the same problem
with no result
(
http://groups.google.com/groups?hl=...=group%3Dmicrosoft.public.outlook.program_vba )
Did anyone get through it?
Here is my script:
********************************************************
Public Sub FilterMail(objMail As MailItem)
Dim utils, PrHeaders, Headers, PrSenderEmail, senderMail
Dim ret, finished, MyspamString, sItem, myAttachment
'On Error Resume Next
MyspamString = "Anti Spam!! - Messaggio automatico - Auto reply"
finished = False
Set utils = CreateObject("Redemption.MAPIUtils")
PrHeaders = &H7D001E
Headers = utils.HrGetOneProp(objMail.MAPIOBJECT, PrHeaders) ' get X
headers
utils.cleanup
For Each myAttachment In objMail.Attachments 'loop through
attachments name, see if any contains my antispamstring
If InStr(1, myAttachment.FileName, spamString) > 0 Then
delMail objMail
finished = True
Exit For
End If
Next
If Not finished Then 'check also subject, body and X-headers
If (InStr(1, objMail.Subject, spamString) > 0) Or (InStr(1,
objMail.Body, spamString) > 0) Or (InStr(1, Headers, spamString) > 0) Then
delMail objMail
finished = True
End If
End If
End Sub
Public Sub delMail(delMail As MailItem)
delMail.UnRead = False
delMail.Save
delMail.Delete
End Sub
********************************************************
The problem occurs even if the sub is:
********************************************************
Public Sub FilterMail(objMail As MailItem)
End Sub
********************************************************
OL2002.
As I've set a white list approach, when unknown mail is received a reply is
sent with a message saying that the sender isn't my address book, and a few
instructions on how to bypass filtering (for friends that may have changed
email addresses, and so on). This obviuosly causes many bounce back mails
with "undeliverable".
So in the RW the first rule is VBA script that checks everywhere in the
incoming message if it is a bounce back message and if so it deletes it.
The complete RW antispam policy is:
1) Run VBA script: check bounce back, if so delete message
2) Check if mail subject contains bypass string, if so stop processibg more
rules
3) Check if sender is in address book, if not move to spam and stop
processing more rules.
4........other rules
Two problems:
1) "Rules in error - The operation failed. An object could not be found." -
Looks like some messages are malformed (headers, mime, dunno what else) so
the script many times fails. Looks like somebodyelse had the same problem
with no result
(
http://groups.google.com/groups?hl=...=group%3Dmicrosoft.public.outlook.program_vba )
Did anyone get through it?
Here is my script:
********************************************************
Public Sub FilterMail(objMail As MailItem)
Dim utils, PrHeaders, Headers, PrSenderEmail, senderMail
Dim ret, finished, MyspamString, sItem, myAttachment
'On Error Resume Next
MyspamString = "Anti Spam!! - Messaggio automatico - Auto reply"
finished = False
Set utils = CreateObject("Redemption.MAPIUtils")
PrHeaders = &H7D001E
Headers = utils.HrGetOneProp(objMail.MAPIOBJECT, PrHeaders) ' get X
headers
utils.cleanup
For Each myAttachment In objMail.Attachments 'loop through
attachments name, see if any contains my antispamstring
If InStr(1, myAttachment.FileName, spamString) > 0 Then
delMail objMail
finished = True
Exit For
End If
Next
If Not finished Then 'check also subject, body and X-headers
If (InStr(1, objMail.Subject, spamString) > 0) Or (InStr(1,
objMail.Body, spamString) > 0) Or (InStr(1, Headers, spamString) > 0) Then
delMail objMail
finished = True
End If
End If
End Sub
Public Sub delMail(delMail As MailItem)
delMail.UnRead = False
delMail.Save
delMail.Delete
End Sub
********************************************************
The problem occurs even if the sub is:
********************************************************
Public Sub FilterMail(objMail As MailItem)
End Sub
********************************************************