Ajout des expéditeurs des mails dans les contacts de Microsoft Outlook

Voila un script loin d’être optimisé mais qui peut vous servir de base pour un développement perso. Il consiste à récuperer les adresses des expéditeurs de mails de la boîte de reception et à les ajouter aux contacts (carnet d’adresses sous Outlook)

Voilà le code à ajouter dans un fichier texte et à renommer en *.vbs.

J’aurais pu optimiser le code en procédant en deux étapes :

  • récuperer les adresses des expéditeurs des mails (chaque adresse est unique)
  • inserer si besoin l’adresse dans les contacts

La ligne ‘If i>10 Then Exit For permet de tester le script sur les premiers messages…


‘On crée les objets utiles pour acceder aux données de Outlook
Set oOutlook = CreateObject(« Outlook.Application »)
Set oNS = oOutlook.GetNameSpace(« MAPI »)
Set oMessages = oNS.GetDefaultFolder(6) ‘On récupère l’ensemble des messages
Set oTousMessages = oMessages.items
Set oContacts = oNS.GetDefaultFolder(10)’On récupère l’ensemble des contacts
Set oTousContacts = oContacts.items
messageCree = «  »
messageUpdate = «  »

‘un premier message pour être sûr d’avoir double cliqué 😉
MsgBox(« La recherche commence… ça peut être très long »)

i = 0
‘on boucle sur l’ensemble des messages
For Each myItem In oTousMessages
 i = i + 1
 ‘If i>10 Then Exit For
 
 ‘Gestion de l’erreur pour les confirmations de lecture qui n’acceptent pas le .reply…
 On Error Resume Next 
 ‘on récupère l’expéditeur en faisant un reply
 Set myReply = myItem.Reply
 If err.number <> 0 Then
  ‘exemple : confirmation de lecture
  ‘MsgBox (err.description)
  ‘myItem.display ‘Pour afficher le message qui pose problème
 Else
  ‘Rechercher le destinataire (Pour chaque expediteur, on regarde s’il existe dans les contacts)
  For Each myRecip In myReply.Recipients
   ‘Afficher l’adresse email
   blnExiste = false
   FOR EACH loItem IN oTousContacts
      IF LCase(loItem.Email1Address) = LCase(myRecip.Address) Then ‘si l’adresse mail est la même
         If myRecip.Address <> myRecip.name Then ‘si le nom est différent de l’adresse mail
          loItem.Save()
         End If
         blnExiste = true
         messageUpdate = messageUpdate & myRecip.name & « ( » & myRecip.Address & « ) » & vbcrlf  
      End IF
   Next
   If not blnExiste Then
    ‘il n’existe pas alors on le crée
    Set loNewContact = oContacts.Items.Add() 
    loNewContact.Fullname = myRecip.name
    loNewContact.Email1Address = myRecip.Address
    loNewContact.save()
    messageCree = messageCree & myRecip.name & « ( » & myRecip.Address & « ) » & vbcrlf
    Set loNewContact = nothing
   End If
   
  Next
  ‘Supprimer les objets
  Set myReply = Nothing 
 End If 
Next

MsgBox(i &  » messages traités »)
MsgBox(« nouveaux contacts crées :  » & vbcrlf & vbcrlf & messageCree)
MsgBox(« Contacts mis à jour :  » & vbcrlf & vbcrlf & messageUpdate)

Laisser un commentaire

Votre adresse de messagerie ne sera pas publiée. Les champs obligatoires sont indiqués avec *