Extraire des adresses mails des messages
catxav
Messages postés
17
Statut
Membre
-
catxav Messages postés 17 Statut Membre -
catxav Messages postés 17 Statut Membre -
Bonjour,
J'aimerais extraire les mails des messages où une centaine d'adresses se trouvent dans A ou CC, je ne sais pas comment les intégrer dans un fichier excel, quelqu'un pourrait-il m'aider ?
Merci par avance,
Catherine.
J'aimerais extraire les mails des messages où une centaine d'adresses se trouvent dans A ou CC, je ne sais pas comment les intégrer dans un fichier excel, quelqu'un pourrait-il m'aider ?
Merci par avance,
Catherine.
A voir également:
- Récupérer les adresses mails de ces message reçu
- Recuperer message whatsapp supprimé - Guide
- Message absence thunderbird - Guide
- Liste de mes adresses mail - Forum Mail
- Epingler un message whatsapp - Accueil - Messagerie instantanée
- Comment recuperer un message supprimé sur whatsapp - Guide
8 réponses
...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
[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
@+
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 ;)
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
simple, car en plus de l'@mail tu risques de récupérer aussi le nom.....
@+
pasthou
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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.
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 ? ;)
