Extraire des adresses mails des messages

...sinon, en VB.....j'ai récupéré le code d'Impec :

[Voila la version V2.0
Elle extrait dans Outlook la liste des emails (destinataire et émetteur) du dossier sélectionné
le problème du retour a la ligne dans Outlook 2007 est résolut]

'Déclaration du tableau dynamique globale contenant la liste des emails
Dim emails() As String
'Extrait dans Outlook la liste des emails (destinataire et émetteur) du dossier sélectionné
'et crée un mail avec la liste des emails
Sub GetEmail()
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim mySelection As Selection
Dim myMailItemLog As Outlook.MailItem
Set myNameSpace = myOlApp.GetNamespace("MAPI")
' initialisation du tableau
ReDim Preserve emails(1)
emails(1) = ""
'Creation du mail de résultat
Set myMailItemLog = myOlApp.CreateItem(olMailItem)
myMailItemLog.Recipients.Add (myNameSpace.CurrentUser)
myMailItemLog.Subject = "Email from Body - " & Now()
myMailItemLog.BodyFormat = olFormatPlain
'On stocke les emails dans le tableau
GetEmailFromFolder myOlApp.ActiveExplorer.CurrentFolder
emails(1) = (UBound(emails) - 1) & " adresses"
'Conversion du tableau en chaine
myMailItemLog.Body = Join(emails, vbCrLf)
myMailItemLog.Display
MsgBox emails(1), vbInformation, "Done"

End Sub
'Explore les dossiers (fonction réentrante)
Sub GetEmailFromFolder(MyFolder)
Dim myItemRec, myItem As Object
Dim myMailItem As Outlook.MailItem
'Tous les dossiers
For Each myItem In MyFolder.Folders
GetEmailFromFolder myItem
Next
'Tous les mails
For Each myItem In MyFolder.Items
If TypeName(myItem) = "MailItem" Then
Set myMailItem = myItem
'Destinataire
For Each myItemRec In myMailItem.Recipients
addMail myItemRec.Name, myItemRec.Address
Next
'emetteur
addMail myMailItem.SenderName, myMailItem.SenderEmailAddress
End If
Next
End Sub
'Rajoute une entrée au tableau emails() si l'email n'existe pas déjà
Sub addMail(Nom, AdresseEmail)
Dim email As String
If Trim(AdresseEmail) <> "" And InStr(AdresseEmail, "@") Then
If Trim(Nom) = "" Then
Nom = AdresseEmail
End If
'Mise en forme du nom pour être bien reconnue par Outlook si on copie colle la liste dans le champs [À...]
Nom = Replace(Nom, ",", " ")
Nom = Replace(Nom, "@", "-")
Nom = Replace(Nom, ";", " ")
Nom = Replace(Nom, "'", "")
email = """" & Nom & """[" + AdresseEmail + "]"
'Pour excel on peu utiliser sous cette forme :
'email = """" & Nom & """" + vbTab + AdresseEmail
' ou
'email = "<A href=""mailto:" & AdresseEmail & """>" & Nom & "</A>"
'Vérification de l'unicité
Find = UBound(Filter(emails, email, True, vbTextCompare))
If Find = -1 Then
'On augmente la taille du tableau et on ajoute
ReDim Preserve emails(UBound(emails) + 1)
emails(UBound(emails)) = email
End If
End If
End Sub

@+
pasthou

...>>OE>>Adresses>Exporter>>Autre carnet d'adresse>>Fichier texte(valeurs séparées par des virgules) et tu crées un fichier csv.

@+
pasthou

Merci Pasthou, mais voilà les adresses ne se trouvent pas dans mon carnet d'adresses Outlook mais dans le corps du message, et là je ne vois pas comment faire...
Merci de ton aide ;)

..dans ce cas, il faut que tu passes par "le code source du message" en en faisant un copier/coller, ça ne va pas être
simple, car en plus de l'@mail tu risques de récupérer aussi le nom.....

@+
pasthou

arfff, oui j'ai déjà essayé et c'est un casse tête chinois pour enlever les <> les noms, les espaces...
Je pensais qu'un script aurait pu extraire les adresses mails mais comme je ne sais pas utiliser VB, pas facile.
En tout cas c'est sympa à toi de m'avoir répondu, je te souhaite une bonne fin de journée. Catherine.

Ah ouais, tip top, un grand merciiii !!!!!!!!!!! mais heu je fais quoi de tout ça ??? excuse moi, un peu (beaucoup) néophyite dans ce domaine, je suppose que je dois copier et le coller mais où donc Mr Pasthou ? ;)

...Sous Outlook, il faut que tu crées une macro et que t'y colles tout ce code...

@+
pasthou

C'est super, juste que ce script a récupéré les mails des messages de tout mon outlook, pas simplement pour un mail en particulier.
Merci à toi ;)