Save date and time of emails into Excel sheet based on email id for last 30 days

Question

This is my code and I'm struck in filtering the date. I need to save the date and time info of User([email protected]) email for last 30 days from now. have to be saved that info(time & date) in Excel sheet

Set ObjO = CreateObject("Outlook.Application")
Set olNs = ObjO.GetNamespace("MAPI")
Set objFolder = olNs.GetDefaultFolder(6)

For Each item1 In objFolder.Items

Dim sa, bc
bc = item1.ReceivedTime
sa = Format(item1.ReceivedTime, "dd-MM-yyyy")

spa = "27/02/2018"

If item1.UnRead And item1.SenderEmailAddress = "[email protected]" And sa < spa Then

I can get the date and time using Item1 object but the challenging part for me is getting that info for last 30days from today.

It should not be more than 1 month.. so for every month i need to generate this macro to give the date and time of the emails of particular User and save that info in excel sheet.

Its a monthly activity which I was doing manually every month

Answer 1

An inefficient method, not first restricting items by the applicable time period.

Private Sub findByDate()

Dim ObjO As Object
Dim olNs As Object
Dim objFolder As Object

Dim item1 As Object

Dim sa As Date
Dim spa As Date

Set ObjO = CreateObject("Outlook.Application")
Set olNs = ObjO.GetNamespace("MAPI")
Set objFolder = olNs.GetDefaultFolder(6)

Set objFolder = olNs.GetDefaultFolder(6)
Debug.Print objFolder

spa = "27/02/2018"
Debug.Print "Oldest date.....: " & spa - 30

Debug.Print "Most recent date: " & spa

For Each item1 In objFolder.Items

    sa = Format(item1.ReceivedTime, "dd-MM-yyyy")

    If sa <= spa Then
        If sa > spa - 30 Then

            Debug.Print item1.ReceivedTime & " - " & item1.Subject

        End If
    End If

Next

Set ObjO = Nothing
Set olNs = Nothing
Set objFolder = Nothing

End Sub