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
