Macro pour extraire les adresses email d'Outlook |
Ci-dessous la macro qui fonctionne pour extraire les adresses mails de ces échanges sous Outlook !
'Déclaration des tableaux dynamiques globaaux contenant la liste des emails
Dim emails(), noms() As String
'Extrait dans Outlook la liste des emails (destinataire, émetteur, corp) 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")
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
source : http://www.commentcamarche.net/forum/affich-3046572-outlook-extraire-adresses-emails-des-emails
|