今日送信されるアイテムを探すItems.restrictメソッド

Question

私は毎週の割り当て（添付ファイル）をダウンロードしてフォルダに保存するコードを書こうとしています。

私はすべての項目を通過してすべての添付ファイルをダウンロードするコードを手に入れましたが、最新の日付から最も早い日付になります。以前の添付ファイルが後のファイルを上書きするため、最新のものが必要です。

今日送信されたアイテムを検索するためにrestrictメソッドを追加しましたが、引き続き受信トレイ全体を通過します。

Sub downloadAttachment() 

Dim ns As NameSpace 
Dim Inbox As MAPIFolder 
Dim Item As Object 
Dim myItems As Items 
Dim Atmt As Attachment 
Dim FileName As String 
Dim i As Integer 
Dim sFilter As String 


'Setting variable for inbox. 
Set ns = GetNamespace("MAPI") 
Set Inbox = ns.GetDefaultFolder(olFolderInbox) 
**sFilter = "[ReceivedTime]>=""&Date()12:00am&""" 
Set myItems = Inbox.Items.Restrict(sFilter)** 

i = 0 

'Error handling. 
On Error GoTo downloadattachment_err 

'if no attachments, msgbox displays. 
If Inbox.Items.Count = 0 Then 
    MsgBox "There are no messages in the Inbox.", vbInformation, _ 
      "Nothing Found" 
    Exit Sub 
End If 

'Goes through each item in inbox for attachments. 
For Each Item In Inbox.Items 
    For Each Atmt In Item.Attachments 
    If Right(Atmt.FileName, 3) = "txt" Then 
     FileName = "C:\losscontroldbases\pendingworkdownload\" & Atmt.FileName 
     Atmt.SaveAsFile FileName 
     i = i + 1 
    End If 
    Next Atmt 
Next Item 

'If attachments found, the displays message. 
If i > 0 Then 
    MsgBox "I found " & i & " attached files." _ 
    & vbCrLf & "I have saved them into the C:\losscontroldbases\pendingworkdownload." _ 
    & vbCrLf & "Have a nice day!" 

Else 
    MsgBox "I didn't find any attached files in your mail." 
End If 

'Clearing memory. 
downloadattachment_exit: 
    Set Atmt = Nothing 
    Set Item = Nothing 
    Set ns = Nothing 
    Exit Sub 

'Error handling code. 
downloadattachment_err: 
    MsgBox " An unexpected error has occured." 

End Sub 

Answer 1

あなたのコードは、「日付」文字列をリテラル値として参照します。

Filter = "[ReceivedTime]>= '" & CStr(Date()) & " 12:00am' "