Outlook .items.restrict 使用两个过滤器

Posted 2023-02-19

【中文标题】Outlook .items.restrict 使用两个过滤器

【英文标题】：Outlook .items.restrict using two filters

【发布时间】：2016-06-01 05:35:29

【问题描述】：

我正在使用一个脚本来打开一封电子邮件并下载其附件。现在我可以选择在最近的电子邮件中下载最近的附件：

Sub CTEmailAttDownload()

Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\TEMP\TestExcel"

    Dim oOlAp As Object
    Dim oOlns As Object
    Dim oOlInb As Object
    Dim oOlItm As Object
    Dim oOlAtch As Object
    Dim oOlResults As Object

    Dim x As Long

    Dim NewFileName As String
    NewFileName = "Daily Tracker " & Format(Now, "dd-MM-yyyy")

    'You can only have a single instance of Outlook, so if it's already open
    'this will be the same as GetObject, otherwise it will open Outlook.
    Set oOlAp = CreateObject("Outlook.Application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    'No point searching the whole Inbox - just since yesterday.
    Set oOlResults = oOlInb.Items.Restrict("[ReceivedTime]>'" & Format(Date - 1, "DDDDD HH:NN") & "'")

    'If you have more than a single attachment they'll all overwrite each other.
    'x will update the filename.
    x = 1
    For Each oOlItm In oOlResults
        If oOlItm.Attachments.Count > 0 Then
            For Each oOlAtch In oOlItm.Attachments
                If GetExt(oOlAtch.FileName) = "xlsx" Then
                    oOlAtch.SaveAsFile AttachmentPath & "\" & NewFileName & ".xlsx"
                End If
                x = x + 1
            Next oOlAtch
        End If
    Next oOlItm

End Sub

'----------------------------------------------------------------------
' GetExt
'
'   Returns the extension of a file.
'----------------------------------------------------------------------
Public Function GetExt(FileName As String) As String

    Dim mFSO As Object
    Set mFSO = CreateObject("Scripting.FileSystemObject")

    GetExt = mFSO.GetExtensionName(FileName)
End Function

通过使用'[Subject] ='，我可以按主题下载。

我的问题是，如何将这两个过滤器放在一起，以便按主题和接收时间进行过滤？

我尝试将它们与 ,、&、+ 绑定在一起，但到目前为止我还没有成功。

【问题讨论】：

再次限制oOlResults 怎么样。喜欢第一个Set oOlResults 下的Set oOlResults = oOlResults.Items.Restrict("[Subject]='" & mySubject)？您也可以将其添加到 If 语句 If oOlItm.Attachments.Count > 0 And oOlItm.Subject = mySubject。

【参考方案1】：

@SQL=(Subject LIKE '%blah%') AND (ReceivedTime > '01/02/2015')

【讨论】：

嗨，德米特里。我会把它放在哪里？在这种情况下，它不会计算为最后一天的电子邮件。

您可以将该过滤器传递给 Items.Restrict 以获取受两个条件限制的集合 - 主题和接收日期。

【参考方案2】：

获得一个限制的语法是一件很困难的事。正如 Scott Holtzman 的评论中所指出的，如果您分别了解每个过滤器，则可以过滤两次。

Option Explicit

Sub CTEmailAttDownload()

    Const olFolderInbox As Integer = 6
    '~~> Path for the attachment
    Const AttachmentPath As String = "C:\TEMP\TestExcel"

    Dim oOlAp As Object
    Dim oOlns As Object
    Dim oOlInb As Object

    Dim oOlItm As Object
    Dim oOlAtch As Object

    Dim oOlResults As Object
    Dim oOlSubjectResults  As Object
    Dim strFilter As String
    Dim i As Long

    Dim x As Long

    Dim NewFileName As String
    NewFileName = "Daily Tracker " & format(Now, "dd-MM-yyyy")

    'You can only have a single instance of Outlook, so if it's already open
    'this will be the same as GetObject, otherwise it will open Outlook.
    Set oOlAp = CreateObject("Outlook.Application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    'No point searching the whole Inbox - just since yesterday.
    Set oOlResults = oOlInb.Items.Restrict("[ReceivedTime]>'" & format(Date - 1, "DDDDD HH:NN") & "'")

    strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%test%'"

    Set oOlSubjectResults = oOlResults.Restrict(strFilter)

    If oOlSubjectResults.count = 0 Then
        Debug.Print "No emails found with applicable subject"

    Else
        'If you have more than a single attachment they'll all overwrite each other.
        'x will update the filename.
        x = 1

        For i = 1 To oOlSubjectResults.count
            Set oOlItm = oOlSubjectResults(i)
            If oOlItm.Attachments.count > 0 Then
                Debug.Print oOlItm.Subject
                For Each oOlAtch In oOlItm.Attachments

                    Debug.Print oOlAtch.DisplayName

                    If GetExt(oOlAtch.FileName) = "xlsx" Then
                        oOlAtch.SaveAsFile AttachmentPath & "\" & NewFileName & ".xlsx"
                    End If
                    x = x + 1
                Next oOlAtch
            End If
        Next i
    End If

ExitRoutine:
    Set oOlAp = Nothing
    Set oOlns = Nothing
    Set oOlInb = Nothing

    Set oOlResults = Nothing
    Set oOlSubjectResults = Nothing

End Sub

【讨论】：

嗨，@niton。我很抱歉，但我现在只能再处理一次了。使用这个确切的代码，我根本无法打开 Outlook 2013。我检查了参考资料，似乎我有正确的库。你知道会发生什么吗？