Chargement... Veuillez patientez...

Bienvenue sur le site de !

(site non professionnel !)

Flash Infos !!

Image
 

PI | FYI

Site Non Professionel !Wink

Total Users

2954 enregistrés
1 Aujourd hui
3 Cette semaine
186 Ce mois-ci
Dernier: GeorgeLeava

Menu principal

Accueil
News
Me contacter
- - - - - - -
Piano
Mon Joomla
Liens
- - - - - - -

Autre menu

Site Map

Boîte à Meuh !

feed image
feed image
Google

Accueil arrow News arrow Webmasters arrow Macro pour extraire les adresses email d'Outlook

Macro pour extraire les adresses email d'Outlook

Convertir en PDF Version imprimable Suggérer par mail

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

Commentaires
Rechercher
Seul les utilisateurs enregistrés peuvent écrire un commentaire!

3.23 Copyright (C) 2007 Alain Georgette / Copyright (C) 2006 Frantisek Hliva. All rights reserved."

 
< Précédent   Suivant >

Se connecter






 
© 2024 Partitions piano, astuces Joomla sur le blog de Jb Burin
Joomla! est un logiciel libre distribué sous licence GNU/GPL.