Outlook vba统计日期之间的文件夹项目

我一直在修改我最初在这个网站上发现的一些代码（fmunkert，2012），其中最初计算了一组文件夹中的邮件数

然后生成两个消息输出（消息1：文件夹中的电子邮件总数，消息2：按日期列出）

我修改了模块，对两组文件夹进行计数，并将它们合并为两条消息中每一条的一组总体统计数据

由于这些文件夹覆盖了整整一年，我想限制第二条消息只显示过去30天的日期，我已尝试设置我相信会检查此区域的区域

然而，我只是得到所有的日期显示1个项目，除了约3个日期显示一个随机数

我的完全修改代码

Sub InboxEmails()

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


    ' Verify exisitence of 2013 Actioned / Updated Folder
    On Error Resume Next
    Set objFolder1 = objnSpace.Folders("test@sample.net").Folders("Inbox").Folders("Alico Metlife  Actioned / Updated").Folders("2013 (Actioned / Updated)")
    If Err.Number <> 0 Then
    Err.Clear
    MsgBox "2013 Actioned / Updated Folder Not Found."
    Exit Sub
    End If

    ' Verify exisitence of 2013 IRs Raised Folder
    On Error Resume Next
    Set objFolder2 = objnSpace.Folders("test@sample.net").Folders("Inbox").Folders("Alico MetLife IRs Raised").Folders("2013 (IRs Raised)")
    If Err.Number <> 0 Then
    Err.Clear
    MsgBox "2013 IRs Raised Folder Not Found."
    Exit Sub
    End If


'All folders are present, OK to continue.

EmailCount1 = objFolder1.Items.Count
EmailCount2 = objFolder2.Items.Count

MsgBox "Number of chargeable emails: " & EmailCount1 + EmailCount2

Dim dateStr As String
Dim myItems1 As Outlook.Items
Dim myItems2 As Outlook.Items
Dim dict As Object
Dim msg As String
Set dict = CreateObject("Scripting.Dictionary")
Set myItems1 = objFolder1.Items
Set myItems2 = objFolder2.Items
myItems.SetColumns ("SentOn")


' Determine date of each message:
For Each myItem In myItems1
    dateStr = GetDate(myItem.SentOn)
    If Not dict.Exists(dateStr) Then
        dict(dateStr) = 0
    End If


    dict(dateStr) = CLng(dict(dateStr)) + 1

Next myItem

' Determine date of each message:
For Each myItem In myItems2
    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

尝试版本2

If Not dict.Equals(dateStr >= IsDate(Now) - 30) Then

尝试版本3

If Not dateStr >= IsDate(Now) - 30 Then

我很确定这将是我需要改变的地方，但我就是不能去工作。如果我知道我在这件事上出了什么问题，我将不胜感激

编辑： 我一直在做更多的研究，并知道我在正确的轨道上，这是我的最新代码

Dim dateStr As Date
Dim myItems2 As Outlook.Items
Dim dict As Object
Dim msg As String
Dim lastweek As Date
Set dict = CreateObject("Scripting.Dictionary")
Set myItems2 = objFolder2.Items
myItems2.SetColumns ("SentOn")

'Determine date of each message:
For Each myItem In myItems2
dateStr = GetDate(myItem.SentOn)

lastweek = Date
If Not dict.Item(dateStr) >= ((lastweek) - 30) Then
dict.Remove myItems2.myItem
Else

dict(dateStr) = CLng(dict(dateStr)) + 1

End If

Next myItem    

虽然我在每一行上都使用了手表，以确保它按预期传递日期，但这仍然不会转到if语句的else部分

“dateStr”显示项目的日期，“（lastweek）-30”显示当前日期前30天的日期

在if语句中，我希望它转到那些日期的语句的else部分，其中日期在30天之内。然而，这并没有发生，我也不明白为什么不发生

参考文献

---

fmunkert（2012），[在线]（访问2013年3月）

我终于无意中发现了我的错误所在，只是发现我的这行代码有错

If Not dateStr >= ((lastweek) - 30) Then

---

这似乎是一个放置此代码的好地方。它按日期统计收件箱中的项目

Sub-UserCount（）
'将您的电子邮件和开始日期放在此处。
收件箱邮件”user@domain.com", "1/1/2014"
端接头
子收件箱邮件（strEmail作为字符串，strStartDate）
Dim objOutlook作为对象，objnSpace作为对象，objFolder作为MAPIFolder_
objDict作为对象，strDate作为字符串
设置objOutlook=CreateObject（“Outlook.Application”）
设置objnSpace=objOutlook.GetNamespace（“MAPI”）
设置objFolder=objnSpace.Folders（strEmail.Folders）（“收件箱”）
设置myItems=objFolder.Items
Set dict=CreateObject（“Scripting.Dictionary”）
'缓存SentOn列。
myItems.SetColumns（“SentOn”）
'按日期统计邮件。
对于myItems中的每个myItem
'仅查找电子邮件，其他对象类型没有SendOn属性。
如果myItem.MessageClass=“IPM.Note”，则
'从日期时间中删除时间。
dateStr=FormatDateTime（myItem.SentOn，2）
'仅在startDate之后查找邮件。
如果CDate（dateStr）>CDate（strStartDate），则
如果不存在dict.Exists（dateStr），则
dict（dateStr）=1
其他的
dict（dateStr）=CLng（dict（dateStr））+1
如果结束
如果结束
如果结束
下一个我的项目
'将结果打印到即时窗口（Ctrl+G）。
对于dict.键中的每个o
调试.打印o&vbTab&dict（o）
下一个
端接头

If Not dateStr >= ((lastweek) - 30) Then