按日期计数Outlook中的电子邮件

问题描述

我有以下代码来计算Outlook文件夹中的电子邮件数量.

I Have the following code to count the number of emails in a 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 end up with a count for each day.

推荐答案

您可以使用以下代码进行尝试:

You might try it 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

这篇关于按日期计数Outlook中的电子邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！