Outlook : courrier indésirable

Bonsoir à tous,

Après XL, Outlook.
J'en ai marre des pourriels....
Le filtre "courrier indésirable" fonctionnant vraiment très mal, j'ai décidé de passer à l'action.
Je me suis dis, si je reçois un mail de quelqu'un qui n'est pas dans mon répertoire perso, c'est que le mail ne m'intéresse pas. Au pire, si le mail provient de quelqu'un que je ne connais pas et que le sujet est intéressant, je rajoute ses coordonnées à mon carnet d'adresse.
D'où mon idée suivante :

Macro testée sous Outlook 2000

Code à insérer dans Appication NewMail de "CetteSessionOutlook"
-------------------------------------------------------------------------------------
Private Sub Application_NewMail()
Module1.CourrierIndesirable
End Sub

Code à insérer dans un module nommé "Module1"
----------------------------------------------------------------
Option Explicit

Public Sub CourrierIndesirable()
Dim ope As Object, opg As Object, cont As Object, mail As Object
Dim trouve As Boolean, contact As Object, opge As Object, opgs As Object
Dim reponse As Object, adrmail As String, conti As Object, reponse2
Dim apc As Object
Set ope = Application.GetNamespace("MAPI")
Set opg = ope.GetDefaultFolder(olFolderInbox)
Set cont = ope.GetDefaultFolder(olFolderContacts)
Set opgs = ope.Folders(1).Folders("Courrier indésirable")
Set opge = opg.Items
Set conti = cont.Items
For Each mail In opge
trouve = False
Set reponse = mail.Reply
adrmail = reponse.Recipients(1).AddressEntry.Address
Set reponse = Nothing
For Each contact In conti
If contact.Class = 40 Then
With contact
If mail.SenderName = contact _
Or adrmail = .Email1Address _
Or adrmail = .Email2Address _
Or adrmail = .Email2Address Then
trouve = True
Exit For
End If
End With
End If
Next
If trouve = False Then
reponse2 = _
MsgBox("Vous venez de recevoir un message" _
& vbCrLf & "dont l'expéditeur est inconnu." _
& vbCrLf & "Voulez vous conservez ce message ?" _
& vbCrLf & vbCrLf & mail.SenderName & vbCrLf _
& adrmail & vbCrLf & mail.Subject, _
vbYesNo + vbInformation + _
vbDefaultButton2, "Courrier indésirable")
If reponse2 = vbNo Then
mail.Move opgs
Else
Set apc = Application.CreateItem(olContactItem)
With apc
.CompanyName = mail.SenderName
.FileAs = mail.SenderName
.Email1Address = adrmail
.Save
End With
Set apc = Nothing
End If
End If
Next
Set opge = Nothing
Set conti = Nothing
Set opgs = Nothing
Set opg = Nothing
Set cont = Nothing
Set ope = Nothing
End Sub

Et voilà...
Et depuis, tous les messages que je reçois et dont je connais les expéditeurs sont classés directement dans le dossier "Boite de réception" et tous les autres, dans le dossier "Courrier indésirable" en cliquant simplement sur le bouton "Non" du MsgBox quand celui çi annonce l'arrivée d'un message dont l'expéditeur est inconnu.
Pour info, si par hasard vous désirez garder un message d'un expéditeur inconnu de votre carnet d'adresse, le fait de cliquer sur "Oui" du MsgBox créé un nouveau contact dans votre carnet d'adresse correspondant à l'expéditeur concerné et de ce fait, tous les futurs messages de cet expéditeurs seront conservés automatiquement dans le dossier "Boite de réception".

La macro est très certainement à améliorer.
A chacun d'en faire bon usage.

Merci de votre attention.
Bonne soirée à tous.

Ronan

P.S. : Si vous la trouvé intéressante (la macro) faites le moi savoir. Ca fais toujours plaisir car mine de rien, j'en ai eu des mals de crânes.