[Outlook] Récupérer adresses email
lebenci
Messages postés
6
Date d'inscription
Statut
Membre
Dernière intervention
-
Zvouloun Messages postés 1 Date d'inscription Statut Membre Dernière intervention -
Zvouloun Messages postés 1 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
je cherche à extraire les adresses emails d'Outlook 2003.
Non pas les emails mais juste les adresses emails de tous mes contacts, y compris ceux ne figurant pas dans mon carnet d'adresse....
Auriez-vous une piste ?
En vous remerciant,
Renaud B.
www.vousfairepart.com
je cherche à extraire les adresses emails d'Outlook 2003.
Non pas les emails mais juste les adresses emails de tous mes contacts, y compris ceux ne figurant pas dans mon carnet d'adresse....
Auriez-vous une piste ?
En vous remerciant,
Renaud B.
www.vousfairepart.com
A voir également:
- [Outlook] Récupérer adresses email
- Recuperer message whatsapp supprimé - Guide
- Comment creer un compte email - Guide
- Récupérer mon compte facebook désactivé - Guide
- Facebook piraté et adresse email changé - Guide
- Comment recuperer une video sur youtube - Guide
2 réponses
J'ai fait cette Sub GetEmail qui recherche tous les emails des personnes qui t'ont envoyés un email ou qui tu as envoyé un email dans le dossier et les sous dossiers en cours de sélection (testé sous oulook 2003)
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")
ReDim Preserve emails(1)
emails(1) = ""
'Create a new email to use as log file
Set myMailItemLog = myOlApp.CreateItem(olMailItem)
myMailItemLog.Recipients.Add (myNameSpace.CurrentUser)
myMailItemLog.Subject = "Email from Body - " & Now()
myMailItemLog.BodyFormat = olFormatPlain
myMailItemLog.Body = Now() & " Starting..." & vbCrLf & vbCrLf
'Go thru all folders
GetEmailFromFolder myOlApp.ActiveExplorer.CurrentFolder
For Each Email In emails
myMailItemLog.Body = myMailItemLog.Body & vbCrLf & Email
Next
myMailItemLog.Body = myMailItemLog.Body & vbCrLf & Now() & " Done. Email addresses extracted: " & UBound(emails)
myMailItemLog.Display
MsgBox Now() & " Done. Email addresses extracted: " & UBound(emails), vbInformation, "Done"
End Sub
Sub GetEmailFromFolder(MyFolder)
Dim myMailItem As Outlook.MailItem
For Each myItem In MyFolder.Folders
GetEmailFromFolder myItem
Next
intMessageCount = UBound(emails)
For Each myItem In MyFolder.Items
If TypeName(myItem) = "MailItem" Then
Set myMailItem = myItem
If MyFolder = "Éléments envoyés" Then
strTemp = myMailItem.Recipients.Item(1).Address
Else
strTemp = myMailItem.SenderEmailAddress
End If
Find = UBound(Filter(emails, strTemp, True, vbTextCompare))
If Find = -1 Then
intMessageCount = intMessageCount + 1
ReDim Preserve emails(intMessageCount)
emails(intMessageCount) = strTemp
End If
End If
Next
End Sub
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")
ReDim Preserve emails(1)
emails(1) = ""
'Create a new email to use as log file
Set myMailItemLog = myOlApp.CreateItem(olMailItem)
myMailItemLog.Recipients.Add (myNameSpace.CurrentUser)
myMailItemLog.Subject = "Email from Body - " & Now()
myMailItemLog.BodyFormat = olFormatPlain
myMailItemLog.Body = Now() & " Starting..." & vbCrLf & vbCrLf
'Go thru all folders
GetEmailFromFolder myOlApp.ActiveExplorer.CurrentFolder
For Each Email In emails
myMailItemLog.Body = myMailItemLog.Body & vbCrLf & Email
Next
myMailItemLog.Body = myMailItemLog.Body & vbCrLf & Now() & " Done. Email addresses extracted: " & UBound(emails)
myMailItemLog.Display
MsgBox Now() & " Done. Email addresses extracted: " & UBound(emails), vbInformation, "Done"
End Sub
Sub GetEmailFromFolder(MyFolder)
Dim myMailItem As Outlook.MailItem
For Each myItem In MyFolder.Folders
GetEmailFromFolder myItem
Next
intMessageCount = UBound(emails)
For Each myItem In MyFolder.Items
If TypeName(myItem) = "MailItem" Then
Set myMailItem = myItem
If MyFolder = "Éléments envoyés" Then
strTemp = myMailItem.Recipients.Item(1).Address
Else
strTemp = myMailItem.SenderEmailAddress
End If
Find = UBound(Filter(emails, strTemp, True, vbTextCompare))
If Find = -1 Then
intMessageCount = intMessageCount + 1
ReDim Preserve emails(intMessageCount)
emails(intMessageCount) = strTemp
End If
End If
Next
End Sub
Bonjour,
Merci pour la macro.
Je viens de l'essayer. Toutefois, j'ai un message d'erreur à la ligne GetEmailFromFolder myOlApp.ActiveExplorer.CurrentFolder :
Compile error : Sub or function not defined.
N'y connaissant rien en visual basic, je suis un peu perdu. Quelqu'un peut-il m'aider ?
Merci !!!
Merci pour la macro.
Je viens de l'essayer. Toutefois, j'ai un message d'erreur à la ligne GetEmailFromFolder myOlApp.ActiveExplorer.CurrentFolder :
Compile error : Sub or function not defined.
N'y connaissant rien en visual basic, je suis un peu perdu. Quelqu'un peut-il m'aider ?
Merci !!!
Bonjour "Monsieur Impec able" je vous ai decouvert sur ce forum et c'est vraiment grace a vous que je m'y suis inscrit/ ce n'est vraiment pas mon habitude. j'ai ete informaticien [chef projet mais j'ai aussi programme en assembleur en son temps 68 il y a .... ans. bref ... aujourd'hui jai traine des annees avec outlook 2003 et je veux recuperer les adresses emails que j'ai enmagasinees durant mon activite d'agent immobilier [adresses de clients potentiels]. j'ai lu tous ou presque tous vos conseils, recopie la version 2 de votre macro avec get et suppression des doublons. j'ai fait run et a priori [mon ordinateur est aussi vieux que moi ] j'ai compris que les deux macros ont ete executees mais je ne sais pas ou sont les adresses. est ce qu'il y un fichier csv quelque part et ou je dois le recuperer ??? ou alors rien n;a marche et j;ai fait n;importe quoi .... pouvez vous m'aider ????