Speed Up E-Mail Count

CloudStrife209
CloudStrife209 used Ask the Experts™
on
I put together the following code as a quick fix to stop someone from manually counting the number of items in a mailbox, but due to the length of time it takes to run its actually quicker to do the manual count

Sub emailCount()
    Dim Namespace As Outlook.Namespace
    Dim mailbox As Outlook.MAPIFolder
    Dim Inbox As Outlook.MAPIFolder
    Dim mailItem As Outlook.mailItem
    Dim Folder As Outlook.MAPIFolder
    Dim inputResponse As Date
    
    Dim Count As Long

    Set Namespace = Application.GetNamespace("MAPI")
    Set mailbox = Namespace.Folders(FolderName)
    Set Inbox = mailbox.Folders("Inbox")
    Set Folder = Inbox.Folders("Complete")
    
    inputResponse = InputBox(Prompt:="Please enter the date that you want to collect information on.", _
                             Title:="Mail Count", _
                             Default:=Date - 1)


    On Error Resume Next
    For Each mailItem In Inbox.Items
        If CDate(Format(mailItem.ReceivedTime, "YYYY/MM/DD")) = #5/31/2011# Then
            Count = Count + 1
        End If
    Next mailItem
    
    For Each mailItem In Folder.Items
        If CDate(Format(mailItem.ReceivedTime, "YYYY/MM/DD")) = #5/31/2011# Then
            Count = Count + 1
        End If
    Next mailItem
    
    On Error GoTo 0

    MsgBox "E-Mails Recieved: " & Count
End Sub

Open in new window


I'm looking into trying to refine it so the process is much quicker, and as long as the code will count a number of folders i'm not fussed how it works.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Software Quality Lead Engineer
Top Expert 2011
Commented:
I'd use a filter,

The code below selects the folders slightly differently but the array contains each of the folders to be processed.

Chris
Sub emailCount()
Dim mailitems As Variant
Dim Fldr As Variant
Dim inputResponse As Date
Dim Count As Long
Dim strFilter As String

    inputResponse = InputBox(Prompt:="Please enter the date that you want to collect information on.", _
                             Title:="Mail Count", _
                             Default:=Format(Date - 1, "dd mmm yyyy"))
'    inputResponse = DateSerial(2011, 5, 31)


    On Error Resume Next
    For Each Fldr In Array(Application.Session.GetDefaultFolder(olFolderinbox), Application.Session.GetDefaultFolder(olFolderinbox).folders("complete"))
        strFilter = "[ReceivedTime] >= '" & Format(inputResponse + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'" & " and " & "[ReceivedTime] < '" & Format(inputResponse + TimeSerial(23, 59, 59), "ddddd h:nn AMPM") & "'"
        Set mailitems = Fldr.items.Restrict(strFilter)
        Count = Count + mailitems.Count
    Next
    
    On Error GoTo 0

    MsgBox "E-Mails Recieved: " & Count
    Set mailitems = Nothing
End Sub

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial