根据发送时间下载附件，使用Excel VBA

Question

我有VBA代码"下载基于发件人姓名的邮件附件"。

有时发送者会在一天内发送多个文件。

我想下载第一个发送的文件，基于发送的时间。

在这种情况下，在代码中要做哪些更改?

Sub DATA()
Dim ol As Object 'Outlook.Application
Dim ns As Object 'Outlook.Namespace
Dim fol As Object 'Outlook.Folder
Dim i As Object
Dim mi As Object 'Outlook.MailItem
Dim at As Object 'Outlook.Attachment
Dim fso As Object 'Scripting.FileSystemObject
Dim dir As Object 'Scripting.Folder
Dim dirName As String
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim f As Integer
' change 1
Dim inboxFol As Object 'Outlook.Folder
Dim subFol As Object 'Outlook.Folder
'Some Set Ups
Set fso = CreateObject(Class:="Scripting.FileSystemObject")
Set ol = CreateObject(Class:="Outlook.Application")
Set ns = ol.GetNamespace("MAPI")
' change 2
Set inboxFol = ns.GetDefaultFolder(6) 'olFolderInbox
Set subFol = inboxFol.Folders("Operation")
'Finding the search item from Oulook Inbox
For Each i In inboxFol.Items
If i.Class = 43 Then
Set mi = i
If mi.Attachments.Count > 0 And InStr(mi.SenderName, "Ahmed") Then
dirName = "C:Work Area"
If fso.FolderExists(dirName) Then
Set dir = fso.GetFolder(dirName)
Else
Set dir = fso.Createfolder(dirName)
End If
'Saving Attachment to a folder
For Each at In mi.Attachments
If Right(at.Filename, 4) = "xlsm" Then
at.SaveAsFile dir.Path & "" & "Daily Work Data.xlsm"
End If
Next at
' change 4
mi.UnRead = False
mi.Move subFol
End If
End If
Next i
'Setting Folder
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:Work Area")
CreateObject("shell.application").Open ("C:Work AreaDaily Work data.xlsm")
End Sub

Answer 1

查找今天发送的第一个文件。

Sub DATA()
Dim ol As Object 'Outlook.Application
Dim Ns As Object 'Outlook.Namespace
Dim i As Object
Dim mi As Object 'Outlook.MailItem
Dim inboxFol As Object 'Outlook.Folder
Dim colItems As Object 'Outlook.Items
Dim strFilter As String
Dim resItems As Object
Set ol = CreateObject(Class:="Outlook.Application")
Set Ns = ol.GetNamespace("MAPI")
Set inboxFol = Ns.GetDefaultFolder(6) 'olFolderInbox
Set colItems = inboxFol.Items
colItems.Sort "[SentOn]", False ' oldest to newest
' https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.senton
strFilter = "[SentOn]>'" & Format(Date, "DDDDD HH:NN") & "'"
Debug.Print "strFilter .....: " & strFilter
' https://learn.microsoft.com/en-us/office/vba/api/outlook.items.restrict
Set resItems = colItems.Restrict(strFilter)
Debug.Print "resItems.Count: " & resItems.Count
If resItems.Count Then
For Each i In resItems
If i.Class = 43 Then
Set mi = i
'If mi.Attachments.Count > 0 And InStr(mi.SenderName, "Ahmed") Then
Debug.Print "Subject.....: " & mi.subject
Debug.Print "SentOn .....: " & mi.SentOn
mi.Display
Exit For ' Exit when the first is found
'End If
End If
Next i
Else
Debug.Print "no items found."

End If
End Sub