• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Count the outlook emails recursively using Excel VBA

Jatinbansal701

New Member
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.


Code:
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
 
Last edited by a moderator:
Back
Top