Counting letters in the forecast by date

Question

I have the following code to count the number of letters in an Outlook folder.

Sub HowManyEmails() 
Dim objOutlook As Object, 
objnSpace As Object, 
objFolder As Object 
Dim EmailCount As Integer 
Set objOutlook = CreateObject("Outlook.Application") 
Set objnSpace = objOutlook.GetNamespace("MAPI")

    On Error Resume Next    
    Set objFolder = objnSpace.Folders("Personal Folders").Folders("Inbox").Folders("report's").Folders("Customer")    
    If Err.Number <> 0 Then    
    Err.Clear   
    MsgBox "No such folder."    
    Exit Sub    
    End If

EmailCount = objFolder.Items.Count    
Set objFolder = Nothing    
Set objnSpace = Nothing    
Set objOutlook = Nothing

MsgBox "Number of emails in the folder: " & EmailCount, , "email count" End Sub

I am trying to count the emails in this folder by date, so I get a bill for every day.

Answer 1

You can try with this code:

Sub HowManyEmails()

    Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
    Dim EmailCount As Integer
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")

        On Error Resume Next
        Set objFolder = objnSpace.Folders("Personal Folders").Folders("Inbox").Folders("report's").Folders("Customer") 
        If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Exit Sub
        End If

    EmailCount = objFolder.Items.Count

    MsgBox "Number of emails in the folder: " & EmailCount, , "email count"

    Dim dateStr As String
    Dim myItems As Outlook.Items
    Dim dict As Object
    Dim msg As String
    Set dict = CreateObject("Scripting.Dictionary")
    Set myItems = objFolder.Items
    myItems.SetColumns ("SentOn")
    ' Determine date of each message:
    For Each myItem In myItems
        dateStr = GetDate(myItem.SentOn)
        If Not dict.Exists(dateStr) Then
            dict(dateStr) = 0
        End If
        dict(dateStr) = CLng(dict(dateStr)) + 1
    Next myItem

    ' Output counts per day:
    msg = ""
    For Each o In dict.Keys
        msg = msg & o & ": " & dict(o) & " items" & vbCrLf
    Next
    MsgBox msg

    Set objFolder = Nothing
    Set objnSpace = Nothing
    Set objOutlook = Nothing
End Sub

Function GetDate(dt As Date) As String
    GetDate = Year(dt) & "-" & Month(dt) & "-" & Day(dt)
End Function

Answer 2

Great solution, thanks a lot, how can I post this in a cell instead of msgbox?