從收到日期指定的Outlook到Excel獲取電子郵件

Question

我正在創建一個宏來按主題收到電子郵件，並在我們的團隊共享框中收到日期。

我使用for循環檢查郵箱中的所有電子郵件，但它需要永遠，因為我的語句檢查1000多封郵件。

如何按特定日期收到電子郵件？ 假設我需要電子郵件12/1/2017到12/30/2017。

關鍵是使用Restrict方法，但我不知道如何使用它。

Sub GetFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

Dim olShareName As Outlook.Recipient
Set olShareName = OutlookNamespace.CreateRecipient("sharemailbox@example.ca")
Set Folder = OutlookNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("sharebox subfolder").Folders("sharebox subfolder2")

i = 1

For Each OutlookMail In Folder.Items

    If ((Range("From_Date").Value <= OutlookMail.ReceivedTime) And _
      (OutlookMail.ReceivedTime <= Range("To_Date").Value)) And _
      OutlookMail.Sender = "sender@example.com" Then

        Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
        Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime

        i = i + 1

    End If

Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

我假設我必須解決的代碼是：

<For Each OutlookMail In Folder.Items>

如何使用Restrict方法聲明？

Answer 1

您可以使用GetTable而不是循環，它必須逐個處理每個電子郵件（或項目）。 GetTable將允許您對文件夾的內容應用過濾器，該過濾器應該運行得更快。

有關更多詳細信息和示例，您可以查看有關Outlook的Folder.GetTable方法的MSDN文章 。

對於您嘗試應用的特定過濾器，我會嘗試：

"([ReceivedTime]>=12/1/17) AND ([ReceivedTime]<=12/30/17)"

Answer 2

您可以像這樣創建受日期限制的項目集合。

Option Explicit

Private Sub EmailInTimePeriod()

    Dim oOlInb As Folder
    Dim oOlItm As Object

    Dim oOlResults As Object
    Dim i As Long

    Dim sFilterLower As String
    Dim sFilterUpper As String
    Dim sFilter As String

    Dim dStart As Date
    Dim dEnd As Date

    Set oOlInb = Session.GetDefaultFolder(olFolderInbox)

    ' https://msdn.microsoft.com/en-us/library/office/ff869597.aspx

    ' 12/1/2017 to 12/30/2017
    'dStart = "2017/12/01"
    'dEnd = "2017/12/30"

    ' 1/12/2018 to 1/15/2018
    dStart = "2018/01/12"
    dEnd = "2018/01/16"

    ' Lower Bound of the range
    sFilterLower = "[ReceivedTime]>'" & Format(dStart, "DDDDD HH:NN") & "'"
    Debug.Print vbCr & "sFilterLower: " & sFilterLower


    ' *** temporary demo lines
    ' Restrict the items in the folder
    Set oOlResults = oOlInb.Items.Restrict(sFilterLower)
    Debug.Print oOlResults.count & " items."

    If oOlResults.count > 0 Then
        For i = 1 To oOlResults.count
            Set oOlItm = oOlResults(i)
            Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
        Next i
    End If
    ' *** temporary demo lines


    ' Upper Bound of the range
    sFilterUpper = "[ReceivedTime]<'" & Format(dEnd, "DDDDD HH:NN") & "'"
    Debug.Print vbCr & "sFilterUpper: " & sFilterUpper


    ' *** temporary demo lines
    ' Restrict the Lower Bound result
    Set oOlResults = oOlResults.Restrict(sFilterUpper)
    Debug.Print oOlResults.count & " items."

    If oOlResults.count > 0 Then
        For i = 1 To oOlResults.count
            Set oOlItm = oOlResults(i)
            Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
        Next i
    End If
    ' *** temporary demo lines


    ' combine the filters
    sFilter = sFilterLower & " AND " & sFilterUpper
    Debug.Print vbCr & "sFilter: " & sFilter

    Set oOlResults = oOlInb.Items.Restrict(sFilter)
    Debug.Print oOlResults.count & " items."

    If oOlResults.count > 0 Then
        For i = 1 To oOlResults.count
            Set oOlItm = oOlResults(i)
            Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
        Next i
    End If


ExitRoutine:
    Set oOlInb = Nothing
    Set oOlResults = Nothing
    Set oOlItm = Nothing
    Debug.Print "Done."

End Sub

請注意，代碼設置為在Outlook中使用。