Code VBA importer email vers Excel..

[crx4me]

Allo,

je suis un peu a bout.. trop grosse semaines..

je suis à la recherche d'un code vba bien simple... mais je ne suis pas capable de trouver..

je veux exporter les email d'un folder outlook vers excel

dossier selectionné / subject / body / date / sender name


est-ce que quelqu'un peut m'aider ?

Merci beaucoup !
GuiGui

 

[kingfadhel]

Re : Code VBA importer email vers Excel..

Après une recherche j'ai trouvé ce code qui fonctionne bien selon l'auteur

Option Explicit
Dim n As Long
Sub Launch_Pad()
     
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim Date1, Date2
     
    Do
         'Date1 = Application.InputBox("Enter a date or select the cell with the starting date", "Start Date", , , , , , 10)
        Date1 = Application.InputBox("Enter a date or select the cell with the starting date", "Start Date", "=J1", , , , , 10)
        If Date1 = False Then Exit Sub
        On Error Resume Next
        Date1 = CDate(Date1)
        On Error GoTo 0
    Loop Until IsDate(Date1)
    Do
         'Date2 = Application.InputBox("Enter a date or select the cell with the ending date", "End Date", , , , , , 10)
        Date2 = Application.InputBox("Enter a date or select the cell with the ending date", "End Date", "=K1", , , , , 10)
        If Date2 = False Then Exit Sub
        On Error Resume Next
        Date2 = CDate(Date2)
        On Error GoTo 0
    Loop Until IsDate(Date2)
     'MsgBox Format(Date1, "dd mmm yyyy") & ", " & Format(Date2, "dd mmm yyyy")
     
    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.PickFolder
     
    n = 2
    Cells.ClearContents 'if there are start/end dates in any cell on this sheet this command will erase them
     
    Call ProcessFolder(olFolder, Date1, Date2)
     
    Set olNS = Nothing
    Set olFolder = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
End Sub

Sub ProcessFolder(olfdStart As Outlook.MAPIFolder, Date1, Date2)
    Dim olFolder As Outlook.MAPIFolder
    Dim olObject As Object
    Dim olMail As Outlook.MailItem
     
   
On Error Resume Next
    For Each olObject In olfdStart.Items
        If TypeName(olObject) = "MailItem" Then
             'Application.StatusBar = olObject.ReceivedTime
             'If olObject.SentOn >= Date1 And olObject.SentOn <= Date2 Then
            If olObject.ReceivedTime >= Date1 And olObject.ReceivedTime <= Date2 Then
                n = n + 1
                Set olMail = olObject
                Cells(n, 1) = olMail.Subject
                If Not olMail.UnRead Then Cells(n, 2) = "Message is read" Else Cells(n, 2) = "Message is unread"
                Cells(n, 3) = olMail.ReceivedTime
                Cells(n, 4) = olMail.LastModificationTime
                Cells(n, 5) = olMail.Categories
                Cells(n, 6) = olMail.SenderName
                Cells(n, 7) = olMail.FlagRequest
                Cells(n, 8) = olMail.reminderset
                Cells(n, 9) = olMail.remindertime
                Cells(n, 10) = olMail.reminderstatus
                Cells(n, 11) = olMail.todotaskordinal
               
            End If
        End If
    Next
    Set olMail = Nothing
    Set olFolder = Nothing
    Set olObject = Nothing
End Sub

Lien Original​