Contando correos electrónicos en Outlook por fecha

Question

Tengo el siguiente código para contar la cantidad de correos electrónicos en una carpeta de Outlook.

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 

que estoy tratando de contar los mensajes de correo electrónico de esta carpeta por fecha, así que termino con un recuento de cada día.

Answer 1

Es posible probar con este código:

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