export du carnet d'adresse avec la date du dernier message reçu

[Gorzyne]

Bonjour,

Je souhaiterais réaliser un export du carnet d'adresse avec la date du dernier message reçu, via une macro vba.

En gros je voudrais faire un balayage des messages, et pour chaque contact, récupérer la date du dernier échange avec cette personne. Je sais pas ce qui est le mieux, faire un double balayage du carnet d'adresse et des messages, ou bien uniquement des messages et aspirer les mails à chaque message ?


Merci pour votre aide
Gorzyne

 

[Gorzyne]

Re : export du carnet d'adresse avec la date du dernier message reçu

C'est bon j'ai réussi

Sub Importercontacts()
    Dim Ol As New Outlook.Application
    Dim Ns As Outlook.Namespace
    Dim Dossier As Outlook.MAPIFolder
    Set Ns = Ol.GetNamespace("MAPI")
    Set Dossier = Ns.Folders(1)
    SearchFolders Dossier
    x = 0
    ThisWorkbook.Save
    MsgBox "terminé !"
End Sub
Private Sub SearchFolders(ByVal Fld As Outlook.MAPIFolder)
    Application.ScreenUpdating = False
    Dim y As Integer
    Dim OLmail 'As Outlook.MailItem
    Dim pceJointe As Outlook.Attachment
    Dim SousDossier As Outlook.MAPIFolder
    On Error Resume Next
    ligne = 2
    For Each SousDossier In Fld.Folders
        If SousDossier.DefaultItemType = 0 Then
            For Each OLmail In SousDossier.Items
                Cells(ligne, 1) = OLmail.SenderName
                Cells(ligne, 2) = OLmail.SenderEmailAddress
                Cells(ligne, 3) = OLmail.ReceivedTime
                Cells(ligne, 4) = OLmail.To
                If Range("objet") Then Cells(ligne, 5) = OLmail.Subject
                ligne = ligne + 1
                DoEvents
            Next OLmail
        End If
        SearchFolders SousDossier
    Next SousDossier
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub