VBA to manage incoming mail

[Riccardo Sileci]

Hi, I'm new to this, and googled everything I possibly could, but was unable to find what I need.
I'm getting too many spams, so had an idea of how to minimize the problem, but have no idea if a code for this already exists or if anybody could help me build a VBA code.

The idea is to setup a rule that runs a VBA rule with the following:

IF the incoming message has "THIS PHRASE" on the subject, then
ADD the sender's address to contact list
IF not
IF the sender's address is already on the contact list, then
EXIT
IF not
Reply to message using a template (which has the "THIS PRASE" in the subject
Permanently Delete message
EXIT
END IF

The template with "THIS PHRASE" will have some sort of explanation that I've been getting too many spam and the sender needs to simply reply to the message to be added to the contact list.

Can anybody help?

 

[Diane Poremsky]

Reply to message using a template (which has the "THIS PRASE" in the subject

on this part - don't reply, just delete. Replying will just get you on more spammers list because it validates the address. If the sender is legit (like from a company you do/did business with), unsubscribe. Otherwise, just delete.

which has the "THIS PRASE" in the subject
Permanently Delete message

This much can be done using straight up rules - if words in the subject, delete (or move to junk mail).

ETA: I would do this in the first rule, or at least one early rule. Move and move on... it will take a little longer for the script to run, so you want the junk gone before the script, otherwise it could slow down processing and mail will be skipped.

IF the incoming message has "THIS PHRASE" on the subject, then
ADD the sender's address to contact list
IF not
IF the sender's address is already on the contact list, then

This is doable - I have one that will get you started - Assign Categories to Messages using Contact Category - it looks up contacts and assigns a category but you can replace that part with anything you want it to do.

'To use in a run a script rule
Sub ContactCategories(Item As MailItem)
     Dim oContact As Outlook.ContactItem
     Dim oSender 'As Outlook.AddressEntry
     Dim SenderID As String
If Item.MessageClass = "IPM.Note" Then
On Error Resume Next
Set oSender = Item.Sender
Debug.Print oSender

On Error Resume Next
If Not oSender Is Nothing Then
     Set oContact = oSender.GetContact
             Set oSender = Nothing

             If oContact Is Nothing Then
               
' create contact here
Set oContact = Application.CreateItem(olContactItem)
With oContact
.Email1Address = Item.SenderEmailAddress
.Email1DisplayName = Item.SenderName
.Email1AddressType = Item.SenderEmailType
.FullName = Item.SenderName
.Save
End With



            Set Item = Nothing
             End If
         End If
End If

End Sub

 

[Riccardo Sileci]

Hi Diane. It works beautifully! Thank you so very much!!

Enviado de meu ASUS_Z00AD usando Tapatalk