Réccuperer la date de réception mail Outlook

madate = Format(olMail.ReceivedTime, "yyyymmdd")

Option Explicit
Option Compare Text

Sub Essai()
    Extraction "Perso", "***@***"

End Sub

Sub Extraction(NomDossier As String, Expediteur As String)
    Dim olApp As Outlook.Application
    Dim olSpace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim olInbox As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim pceJointe As Outlook.Attachment
    Dim y As Integer, x As Integer
    Dim madate
    Dim chemin As String
 
    madate = Format(olMail.ReceivedTime, "yyyymmdd")
    
    Set olApp = New Outlook.Application
    Set olSpace = olApp.GetNamespace("MAPI")
    Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)
    Set olFolder = olInbox.Folders(NomDossier)
 
    For Each olMail In olFolder.Items
        If olMail.SenderEmailAddress = Expediteur And Not olMail.Attachments.Count = 0 Then
            For y = 1 To olMail.Attachments.Count
                 Set pceJointe = olMail.Attachments(y)
                 Call RepertoireExiste("E:\Test\" & madate)
                 chemin = "E:\Test\" & madate & "\"
                 pceJointe.SaveAsFile chemin & pceJointe
                 Set pceJointe = Nothing
            Next y
        End If
    Next olMail
 
End Sub

Function RepertoireExiste(chemin As String) As Boolean

On Error Resume Next

RepertoireExiste = GetAttr(chemin) And vbDirectory

    If RepertoireExiste = True Then
        Exit Function
    Else
        MkDir (chemin)
    End If
    
End Function