Speed Up E-Mail Count

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

Select allOpen 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.