Discussion :

[guillaumega]

Bonjour,

Je cherche à récupérer tous les emails des champs A DE et CC de tous les emails de mon outlook.

Y a t'il un programme qui permette de faire cela s'il vous plait?

En vous remerciant,
Cordialement,
Guillaumega

[Oliv-]

Bonjour,
A adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub AddRecipToContacts(objMail As Outlook.MailItem)
'---------------------------------------------------------------------------------------
' Procedure : AddRecipToContacts
' Author    : Oliv-
' Date      : 21/01/2013
' Purpose   :
'---------------------------------------------------------------------------------------
'
    Dim strFind As String
    Dim strAddress As String
    Dim objNS As Outlook.NameSpace
    Dim colContacts As Outlook.Items
    Dim objContact As Outlook.ContactItem
    Dim objRecip    'As Outlook.Recipient
    Dim i As Integer
    On Error Resume Next
 
    ' get Contacts folder and its Items collection
    Set objNS = Application.GetNamespace("MAPI")
    Set colContacts = _
    objNS.GetDefaultFolder(olFolderContacts).Items
 
    ' process message recipients
    objRecip = objMail.SenderEmailAddress
    ' check to see if the recip is already in Contacts
    strAddress = AddQuote(objRecip)
    For i = 1 To 3
        strFind = "[Email" & i & "Address] = " & _
                  strAddress
        Set objContact = colContacts.Find(strFind)
        If Not objContact Is Nothing Then
            Exit For
        End If
    Next
 
    ' if not, add it
    If objContact Is Nothing Then
        Set objContact = _
        Application.CreateItem(olContactItem)
        With objContact
            .FullName = objMail.SenderName
            .Email1Address = strAddress
            .Save
        End With
    End If
    Set objContact = Nothing
 
 
    Set objNS = Nothing
    Set objContact = Nothing
    Set colContacts = Nothing
End Sub

[guillaumega]

Merci beaucoup je vais essayer cela!!
Guillaumega