Outlook via VBA

Bonjour à tous ,

Je reviens vous solliciter sur une problématique

la macro ci dessous récupère mes e-mails d'une boite email précise ,

je souhaiterai qu'elle me récupère les e-mail d'une date précise , et le scannage des emails ce fassent de la date la plus récente a la plus ancien , afin de gagner du temps dans l'exécution de celle ci

D'avance merci de votre aide :-)

Sub Mails_reçus()
Sheets("Feuil1").Select
Sheets("Feuil1").Range("A3:B600").Clear

'définition variables
Dim olk As Object, Dossier As Object, message As Object, éléments_reçus As Object
Dim Comptes_messagerie()
Dim i As Long
Dim N As Integer

'// création objet instance application Outlook
Set olk = CreateObject("Outlook.Application")

'// définition Comptes de messagerie
Comptes_messagerie = Array("att@toto.fr")

'// balayage Dossiers Outlook
For Each Dossier In olk.GetNamespace("MAPI").Folders
If UBound(Filter(Comptes_messagerie, Dossier.Name)) > -1 Then
'assignation éléments reçus du Compte de messagerie
Set éléments_reçus = Dossier.Folders("toto")

'balayage messages reçus
For Each message In éléments_reçus.Items
With ActiveSheet
i = .Columns("A").Find("").Row
.Cells(i, "A") = message.SentOnBehalfOfName
.Cells(i, "B") = message.Subject
.Cells(i, "C") = message.ReceivedTime
End With
Next message
End If
Next Dossier

'// libération objet instance application outlook
Set olk = Nothing

End Sub

Edit modo : merci de mettre le code entre balise, grâce au bouton </>

Bonjour,

ci-dessous code

Sub Filtrage_Mails_reçus()

    'définition variables
    Dim olk As Object, Dossier As Object, message As Object, éléments_reçus As Object, messages_trouvés As Object
    Dim Comptes_messagerie()
    Dim i As Long
    Dim date_rech As Date, filtre As String

    '// création objet instance application Outlook
    Set olk = CreateObject("Outlook.Application")

    '// définition Comptes de messagerie
    Comptes_messagerie = Array("att@toto.fr")

    '// balayage Dossiers Outlook
    For Each Dossier In olk.Session.Folders
        If UBound(Filter(Comptes_messagerie, Dossier.Name)) > -1 Then
            'assignation éléments reçus du Compte de messagerie
            Set éléments_reçus = Dossier.Folders("Boîte de Réception")

            'recherche des messages correspondant à une date
            date_rech = CDate("04/07/2021")
            filtre = "[ReceivedTime] > '" & Format(date_rech - 1, "ddddd") & "'" & "And" & "[ReceivedTime] < '" & Format(date_rech + 1, "ddddd") & "'"
            Set messages_trouvés = éléments_reçus.Items.Restrict(filtre)

            For Each message In messages_trouvés
                If Int(message.ReceivedTime) = date_rech Then
                    With ActiveSheet
                        i = .Columns("A").Find("").Row
                        .Cells(i, "A") = message.SentOnBehalfOfName
                        .Cells(i, "B") = message.Subject
                        .Cells(i, "C") = message.ReceivedTime
                    End With
                End If
            Next message
        End If
    Next Dossier

    '// libération objet instance application outlook
    Set olk = Nothing

End Sub

ça marche !!!

un grand merci à toi thev