2

我一直在修改我最初在这个网站上找到的一些代码（fmunkert，2012），其中最初计算了一组文件夹中的项目（电子邮件）的数量。

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

我已经修改了模块以计算两个集合文件夹并将它们组合成两个消息中每一个的一组整体统计信息。

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

但是，除了大约 3 个日期显示一个随机数之外，我只得到显示 1 个项目的所有日期。

我完全修改的代码

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 语句的 else 部分。

'dateStr' 显示项目的日期，而 '(lastweek) - 30' 显示当前日期前 30 天的日期。

有了这个在 if 语句中，我希望它转到那些日期的语句的 else 部分，其中日期在 30 天内。但是，这不会发生，我不明白为什么不发生。

参考
fmunkert (2012)，按日期计算 Outlook 中的电子邮件[在线]（访问 03/2013）

4

2 回答 2

0

好吧，我终于偶然发现了我出错的地方，只是发现我的这行代码有问题

If Not dateStr >= ((lastweek) - 30) Then
于 2013-03-12T14:47:59.000 回答
0

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

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
于 2014-07-28T15:35:31.647 回答