显示按日期分隔的收件箱中的电子邮件数

时间:2013-12-16 21:36:20

标签: vba email outlook outlook-vba

我想显示收件箱中按日期分隔的电子邮件数量,然后将包含该信息的电子邮件发送给特定用户。

我在这里所做的一切都有效,除了昨天的日期 - 它显示了+1的电子邮件数量。其他电子邮件数量是正确的。

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("Mailbox - IT Support Center").Folders("NON TICKET related Emails")

    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 & " Total Non-Ticket 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:
    For Each o In dict.Keys
        msg = msg & o & ":    " & dict(o) & " Non-Ticket items" & vbCrLf
    Next

    MsgBox msg

    Set objFolder = Nothing
    Set objnSpace = Nothing
    Set objOutlook = Nothing

    'Send Mail
    Set OutApp = CreateObject("outlook.Application")
    Set OutMail = OutApp.CreateItem(o)

    With OutMail
        .Subject = "Non Ticket Emails"
        .To = "johndoe@yahoo.com; Jimmydoe@schneider.com"
        .Body = msg
        .Display
        .Send
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

好的,我发现了这个问题。脚本捕获发送的时间,而不是接收的时间(前景排序)。我已经在代码中改变了发送到接收时间并且它有效!

相关问题