Récuperer en automatique les emails outlook avec VBA

bonjour à tous ,

Je souhaite récuperer en automatique les courriel de outlook

le problème : je voudrais récuperer les courriels de la date (ReceivedTime) que j'aurais choisit.

Pour le moment l'ensemble des courriels de ma boite outlook sont récupérés

D'avance merci

Sub Macro1()

Dim olapp As New Outlook.Application

Dim ns As Object, Dossier As Object

Dim OlExp As Object

Dim i As Object

Application.Worksheets("email").Range("A2:R60000").Clear

Sheets("email").Select

Set ns = olapp.GetNamespace("MAPI")

Set Dossier = ns.GetDefaultFolder(olFolderInbox).Folders("RH") 'Dans la boite de reception dans le repertoire Courriers Traités

b = 2

For Each i In Dossier.Items

Cells(b, 2) = i.ReceivedTime

Cells(b, 1) = i.Subject

b = b + 1

Next i

End Sub '

Bonjour,

à tester,

Sub test()
Dim objNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim Item As Object
Dim dt1 As Double, dt2 As Double

Set objNS = GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)

dt1 = DateSerial(2019, 6, 7) 
dt2 = DateSerial(2019, 6, 8) 

With olFolder
    For i = 1 To .Items.Count
        If TypeOf .Items(i) Is Outlook.MailItem Then
          If .Items(i).ReceivedTime >= dt1 And .Items(i).ReceivedTime < dt2 Then
            n = n + 1
            Cells(n, 1) = .Items(i).Subject 
            Cells(n, 2) = .Items(i).ReceivedTime
          End If
        End If
    Next
End With
End Sub

bonjour à tous ,

merci i20100 pour ton aide ,

je rencontre toujours un soucis pour pouvoir sélectionner les courriel avec la date ReceivedTime

Le format de ma date de mon extraction est sous le format 08/11/2018 16:37:27

but: pourvoir extraire les courriels d'une date sélectionnée

Sub Macro1()

Dim objNS As Outlook.Namespace

Dim olFolder As Outlook.MAPIFolder

Dim Item As Object

Dim dt1 As Date

Dim dt2 As Date

Application.Worksheets("email").Range("A2:R60000").Clear

Sheets("email").Select

Set objNS = GetNamespace("MAPI")

Set olFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("RH")

dt1 = ("03/11/2018 ")

dt2 = ("03/11/2018 ")

With olFolder

For i = 1 To .Items.Count

If TypeOf .Items(i) Is Outlook.MailItem Then

If .Items(i).ReceivedTime >= dt1 And .Items(i).ReceivedTime < dt2 Then

n = n + 1

Cells(n, 1) = .Items(i).Subject

Cells(n, 2) = .Items(i).ReceivedTime

End If

End If

Next

End With

End Sub

je rencontre toujours un soucis pour pouvoir sélectionner les courriel avec la date ReceivedTime

Le format de ma date de mon extraction est sous le format 08/11/2018 16:37:27

but: pourvoir extraire les courriels d'une date sélectionnée

si tu utilises DateSerial et que tu déclares les variables correctement tu n'aura pas de problème de format de date.

Ca marche !!! par contre Attention ne pas avoir une boite émail trop volumineuse sinon ça ne marchera pas.

Merci i20100

Sub Macro1()

Dim objNS As Outlook.Namespace

Dim olFolder As Outlook.MAPIFolder

Dim Item As Object

Dim dt1 As Date

Dim dt2 As Date

Dim RT As Long

Application.Worksheets("email").Range("A2:R60000").Clear

Sheets("email").Select

Set objNS = GetNamespace("MAPI")

Set olFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("1")

dt1 = DateSerial(2019, 6, 1)

dt2 = DateSerial(2019, 6, 31)

MsgBox dt1

MsgBox dt2

With olFolder

For i = 1 To .Items.Count

If TypeOf .Items(i) Is Outlook.MailItem Then

If .Items(i).ReceivedTime >= dt1 And .Items(i).ReceivedTime <= dt2 Then

n = n + 1

Cells(n, 1) = .Items(i).Subject

Cells(n, 2) = .Items(i).ReceivedTime

End If

End If

Next

End With

End Sub

Rechercher des sujets similaires à "recuperer automatique emails outlook vba"