将Outlook项目限制为今天的日期-VBA

时间:2018-12-20 19:34:39

标签: vba outlook outlook-vba outlook-filter

我已经编写了一些代码,可以扫描我的默认Outlook收件箱中是否有今天收到的带有特定主题的电子邮件。

然后我下载符合我的条件的Outlook项目的附件。我在指定Restrict方法以撤回今天收到的项目时遇到麻烦。

这是我所拥有的:

Sub DownloadAttachmentFirstUnreadEmail()

Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
Dim sFilter As String
Dim NewFileName As String

NewFileName = "C:\Temp\" & "CHG_Daily_Extract_" & Format(Date, "MM-DD-YYYY") & ".csv"

'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

'Declare email item restriction
sFilter = "[ReceivedTime] = '" & Format(Date, "DDDDD HH:NN") & "'"

'Catch
If oOlInb.Items.Restrict(sFilter).Count > 0 Then


'~~> Loop thru today's emails
For Each oOlItm In oOlInb.Items.Restrict(sFilter)

    '~> Check if the email subject matches
    If oOlItm = "ASG CDAS Daily CHG Report" Then

     '~~> Download the attachment
     For Each oOlAtch In oOlItm.Attachments
              oOlAtch.SaveAsFile NewFileName
            Exit For
        Next
        End If

    Exit For
Next

'Display if no emails today
Else: MsgBox "No items"

End If
End Sub

运行代码时,我始终收到“没有项目”的捕获消息。

如果我使用的Restrict方法不正确,请告知我。非常感谢您的帮助。

1 个答案:

答案 0 :(得分:0)

以下内容如何?

Filter = "@SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
                               Chr(34) & ")%

或带有附件

Filter = "@SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
                               Chr(34) & ")% AND " & _
                               Chr(34) & "urn:schemas:httpmail:hasattachment" & _
                               Chr(34) & "=1"

示例

Option Explicit
Private Sub Examples()
    Dim olNs As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim Msg As String
    Dim i As Long
    Dim Filter As String

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

    Filter = "@SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
                                   Chr(34) & ")%"


    Set Items = Inbox.Items.Restrict(Filter)

    Msg = Items.Count & " Items in " & Inbox.Name

    If MsgBox(Msg, vbYesNo) = vbYes Then
        For i = Items.Count To 1 Step -1
            Debug.Print Items(i) 'Immediate Window
        Next
    End If
End Sub

Filtering Items Using a Date-time Comparison MSDN

Outlook日期时间宏

下面列出的日期宏返回过滤器字符串,这些字符串将给定date-time属性的值与UTC中的指定日期进行比较; SchemaName是名称空间引用的任何有效日期时间属性。

注意:Outlook日期时间宏只能在DASL查询中使用。

宏语法说明

  1. 今天 %today(" SchemaName")% 对具有SchemaName的项目的限制 财产价值等于今天

More Examples Here