Question

我需要一个VBA代码来计算邮件（特定于日期和时间）。我基本上需要的是代码，告诉我从xx / xx / 2013 5:30 PM到现在（当前日期和时间）总共收到了多少邮件。

以下是我正在运行的代码，但它计算收件箱中的总邮件数。我希望它能确保根据日期和时间。

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 = ActiveExplorer.CurrentFolder
Set objFolder = Session.GetFolderFromID(Application.ActiveExplorer.CurrentFolder.EntryID)

    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 ("ReceivedTime")
' Determine date of each message:
For Each myItem In myItems
    dateStr = GetDate(myItem.ReceivedTime)
    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

Dim fso As Object
Dim fo As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.CreateTextFile("C:\Users\x152833\outlook_log.txt")
fo.Write msg
fo.Close

Set fo = Nothing
Set fso = Nothing
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 1

2013年10月1日，它看起来像这样

    Set olItems = olFldr.Items.Restrict("[ReceivedTime] >= """ & Format(DateSerial(2013, 10, 1) + TimeSerial(17, 30, 0), "ddddd hh:mm AMPM") & """")

    MsgBox "Number of emails in the folder: " & olItems.Count, , "email count"

需要VBA代码来计算邮件（特定日期和时间）

1 个答案: