Count the outlook emails recursively according to different criterion using VBA Excel|VBA & Macros|Excel Forum|My Online Training Hub

I have to count the number of emails I received within a week according to certain criterion depending upon the sender and subject of mails. I am able to this for only one folder using code below. But I want to do it for all folders and sub-folders recursively.


Dim objOutlook As Object, objnSpace As Object, objFolder As Outlook.MAPIFolder
Dim EmailCount As Integer

Sub HowManyDatedEmails()

Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")

On Error Resume Next
Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox)
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If

Dim iCount As Integer, DateCount1 As Integer
Dim myDate1 As Date
Dim myDate2 As Date
Dim DateCount2 As Integer

EmailCount = objFolder.Items.Count
DateCount1 = 0
DateCount2 = 0
myDate1 = Sheets("Sheet1").Range("A1").Value
myDate2 = Sheets("Sheet1").Range("B1").Value

For iCount = 1 To EmailCount
With objFolder.Items(iCount)

If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) >= myDate1 And _
DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) <= myDate2 And _
.SenderEmailAddress Like "*kailash*" And .Subject like "*abc*" Then
DateCount1 = DateCount1 + 1
End If

If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) >= myDate1 And _
DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) <= myDate2 And _
.SenderEmailAddress Like "*soumendra*" And .Subject like "*abc*" Then
DateCount2 = DateCount2 + 1
End If

End With
Next iCoun

Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
Sheets("Sheet1").Range("B2").Value = DateCount1
Sheets("Sheet1").Range("B3").Value = DateCount2

End Sub

The basic idea is to have an excel sheet which will a list of criterion and respective count figure. I am okay for feeding criterion manually. I just need to automate the count function. Any help will be appreciated. I want to do this in Excel VBA and not in Outlook VBA