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>

如何使用限制方法声明语句？

Answer 1

您可以使用GetTable而不是循环，它必须逐个处理每个电子邮件（或项目）。 "([ReceivedTime]>=12/1/17) AND ([ReceivedTime]<=12/30/17)"将允许您对文件夹的内容应用过滤器，该内容应该更快地运行。

有关详细信息和示例，您可以查看MSDN article on the Folder.GetTable Method for Outlook。

对于您尝试应用的特定过滤器，我会尝试：

def getLogger(name):

daiquiri.setup(
    level=app.config.get('LOG_LEVEL', logging.INFO),
    outputs=(<tab><tab><tab><tab><tab>
        daiquiri.output.File(directory="log"),
    ))

return daiquiri.getLogger(name)

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中使用。

从收到日期指定的Outlook到Excel获取电子邮件

2 个答案: