Outlook vba計數日期之間的文件夾項目

Question

我一直在修改一些代碼（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 

嘗試版本1

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

嘗試版本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語句的其他部分。

'dateStr'顯示項目的日期，'（lastweek） - 30'顯示當前日期前30天的日期。

由於存在於if語句中，我期望它能夠在日期在30天內轉到那些日期的其他部分。然而，這不會發生，我不明白爲什麼不。

參考
fmunkert（2012），Counting emails in outlook by date [在線]（接入03/2013）

Answer 1

這似乎是一個放置此代碼的好地方。它按日期統計收件箱項目。

Sub UserCount() 

    ' Put your email, and start date here. 
    InboxEmails "user@domain.com", "1/1/2014" 

End Sub 

Sub InboxEmails(strEmail As String, strStartDate) 

    Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder, _ 
    objDict As Object, strDate As String 

    Set objOutlook = CreateObject("Outlook.Application") 
    Set objnSpace = objOutlook.GetNamespace("MAPI") 
    Set objFolder = objnSpace.Folders(strEmail).Folders("Inbox") 

    Set myItems = objFolder.Items 
    Set dict = CreateObject("Scripting.Dictionary") 

    ' Cache the SentOn column. 
    myItems.SetColumns ("SentOn") 

    ' Count messages by date. 
    For Each myItem In myItems 

     ' Only look for emails, other object types do not have a SendOn property. 
     If myItem.MessageClass = "IPM.Note" Then 

      ' Strip time from datetime. 
      dateStr = FormatDateTime(myItem.SentOn, 2) 

      ' Only find messages after startDate. 
      If CDate(dateStr) > CDate(strStartDate) Then 

        If Not dict.Exists(dateStr) Then 
         dict(dateStr) = 1 
        Else 
         dict(dateStr) = CLng(dict(dateStr)) + 1 
        End If 

      End If 

     End If 

    Next myItem 

    ' Print the results to the Immediate Window (Ctrl + G). 
    For Each o In dict.Keys 
     Debug.Print o & vbTab & dict(o) 
    Next 

End Sub 

Answer 2

嗯，我終於跨越，我已經走錯了迷迷糊糊的，只是發現這行我的代碼有過錯

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