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(harshahowrang@gmail.com) 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 = "harshahowrang@gmail.com" 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

https://stackoverflow.com/search?tab=votes&q=user%3a4539709%20%5boutlook-filter%5d — 0m3r, Feb 28 '18 at 05:33

score 2 · Accepted Answer · answered Feb 27 '18 at 21:20

2

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

answered Feb 27 '18 at 21:20

niton

8,771
21
32
52

This worked perfectly..made bit changes as per my requirement and working now. Thanks niton.. :) – harsha kazama Feb 28 '18 at 05:59
I works in my Pc perfectly without any issue and error. but when im, trying to run in Other pc's its giving an error.. Run time error 430. class does not support Automation or doesnot support expected interface.please help me out – harsha kazama Mar 05 '18 at 15:55
If you have a new question ask it separately. Include the code and information such as the line with the error, to increase the probability of an answer. – niton Mar 05 '18 at 18:25

score 0 · Answer 2 · answered Feb 27 '18 at 08:05

0

Currently your variables sa and spa are treated as string.You have to declare them as date in order to do the date comparison.

dim sa as date
dim bc as date
dim spa as date

answered Feb 27 '18 at 08:05

Imran Malek

1,709
2
13
14

score 0 · Answer 3 · answered Feb 28 '18 at 05:31

With niton example Here is another example Filter for 30 days

Dim DateDiff As Long
DateDiff = Now - 30
Dim Filter As String
Filter = "[SentOn]  < '" & Month(DateDiff) & "/" & _
                           Day(DateDiff) & "/" & _
                           Year(DateDiff) & "'"

Using Items.Restrict Method (Outlook)

Example on loop https://stackoverflow.com/a/42547062/4539709

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

3 Answers3