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)
http://www.golden-trade.com/cnt/brs-catalog/brs_contact_prod.asp?uid_prod=633
un article sur une tente qui s’ouvre en 9 secondes…
Mise à jour 15/05/2005 20:58 – Bruno
Enfin une page dédiée à la tente sur la page du site :
http://www.quechua.com/Quechua/index.asp?int_DeptId=55&int_DeptPereId=&int_ModuleId=1&lg=FR
avec une vidéo sur le repliage : visiblement c’est la crainte…
http://www.quechua.com/AfficheQuechua/media/video/tente2Sec_Repliage_300k.wmv
et une fiche déscriptive détaillée :
http://www.decathlon.fr/Contenu/Tente2005/tente_2seconds.htm
Et aujourd’hui une superbe pub sur France 3 ! Quand je la trouve, je vous la mets !
Mise à jour 17/05/2005 13:31 – Bruno
Voilà mes vidéos du montage et démontage de la tente deux secondes !
Montage de la tente (1,1 Mo, DivX)
Montage de la tente (493ko, Wmv)
Démontage de la tente (3,5 Mo, DivX)
Démontage de la tente (1,3 Mo, Wmv)
Mise à jour 18/05/2005 00:52 – Bruno
Une nouvelle vidéo accessible sur le site de Quechua nommée « mode d’emploi » :
http://winmedia.mm.atos-group.com:8500/decathlon/tente2Sec_Repliage_300k.wmv (6,08 Mo, Wmv)