Question

我正在尝试编写代码来下载每周作业（附件）并将其保存到文件夹中。

我得到了一个代码，遍历每个项目并下载所有附件，但它从最新到最早的日期。我需要最新的附件，因为早期的附件会覆盖后面的附件。

我添加了一种限制方法来查找今天发送的项目，但它仍然会通过整个收件箱。

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

您的代码引用＆＃34;日期＆＃34; string作为文字值。使用像

这样的东西

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

Items.restrict方法查找今天发送的项目

1 个答案: