从上个月的已发送文件夹中检索Outlook电子邮件计数（通过单词VBA）

Question

我一直在尝试过滤Word中的Outlook发送文件夹，以获取上个月的总电子邮件数。

' Connect to outlook
Dim outlook As Object
Dim NumEmails As Long
Dim name_space As Object
Dim SentFolder As MAPIFolder
Dim criterion As String

Set outlook = CreateObject("Outlook.Application")
Set name_space = outlook.GetNamespace("MAPI")

On Error Resume Next
Set SentFolder = name_space.GetDefaultFolder(olFolderSentMail)
If Err.Number <> 0 Then
    Err.Clear
    MsgBox "No such folder."
    Exit Sub
End If

If Month(Date) = 1 And Day(Date) < 27 Then
    ' It's January but we're reporting Decemember
    criterion = ""
ElseIf Day(Date) > 27 Then
    ' It's the end of the month; pull this month's data
    criterion = ""
Else
    ' It's not the end of the month; pull last month's data
    criterion = ""
End If

这是我到目前为止所得到的，但我坚持要把什么作为我的标准变量以及如何利用它来过滤文件夹。

任何帮助将不胜感激。

Answer 1

使用来自多个可能站点之一的日期代码，您可以像这样过滤：

Option Explicit

Private Sub ItemsByMonth()

    Dim myStart As Date
    Dim myEnd As Date

    Dim outlook As Object
    Dim name_space As Object
    Dim SentFolder As Object

    Dim oItems As Items
    Dim oitem As Object

    Dim strRestriction As String
    Dim oResItems As Items

    Set outlook = CreateObject("Outlook.Application")
    Set name_space = outlook.GetNamespace("MAPI")

    ' http://www.anysitesupport.com/vba-time-and-date-functions/
    If Day(Date) < 27 Then
        'Last day of previous month
        myEnd = DateSerial(Year(Date), Month(Date), 0)
    Else
        'Last day of month
        myEnd = DateSerial(Year(Date), Month(Date) + 1, 0)
    End If

    ' First day of the myEnd month
    myStart = DateSerial(Year(myEnd), Month(myEnd), 1)

    Set SentFolder = name_space.GetDefaultFolder(olFolderSentMail)
    Set oItems = SentFolder.Items

    strRestriction = "[SentOn] <= '" & myEnd & "' AND [SentOn] >= '" & myStart & "'"
    Set oResItems = oItems.Restrict(strRestriction)
    Debug.Print oResItems.count

ExitRoutine:
    Set outlook = Nothing
    Set name_space = Nothing
    Set SentFolder = Nothing
    Set oItems = Nothing
    Set oResItems = Nothing

End Sub