下面的代码很简单并且有效，但是需要对其进行修改，以便在 Outlook 文件夹中查看时，它只查看接收日期为今天的邮件项目。我花了几个小时试图解决这个问题。
Sub Command0_Click()
Dim OlApp As Object
Dim OlMail As Object
Dim OlItems As Object
Dim OlFolder As Object
Dim J As Integer
Dim strFolder As String
Dim CurrentDate As String
CurrentDate = Format(Now, "YYYYMMDD") '
Dim aFile As String
On Error Resume Next
Set OlApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set OlApp = CreateObject("Outlook.Application")
End If
strFolder = "H:\TEST_DROP\" ' Folder where saving attachments
'''Outlook folder path
'Change Folder to your email adddress
'Change inbox to your subfolder in the your main mailbox
Set OlFolder = OlApp.getnamespace("MAPI").Folders("MyEmail@my_company.com").Folders("Inbox").Folders("TEST_ML")
Set OlItems = OlFolder.Items
''looks in each email in that folder and saves attachments in strFolder
'''THE CODE HERE NEEDS TO BE MODIFIED TO ONLY LOOK AT THE EMAILS WITH A RECEIVED DATE OF TODAY only....
For Each OlMail In OlItems
If OlMail.Attachments.Count > 0 Then
For J = 1 To OlMail.Attachments.Count
OlMail.Attachments.Item(J).SaveAsFile strFolder & OlMail.Attachments.Item(J).FileName
Next J
End If
Next
Set OlFolder = Nothing
Set OlItems = Nothing
Set OlMail = Nothing
Set OlApp = Nothing
''''RENAME FILE WITH CURRENT DATE SUFFIX
Name "H:\TEST_DROP\Remittance_YYYYMMDD.csv" As "H:\TEST_DROP\Remittance_" & CurrentDate & ".csv"
End Sub
每个邮件项目都有一个属性 OlMail.ReceivedTime
你需要将它与 Now()
像这样：
If (Now() - OlMail.ReceivedTime) < 1 Then
这是有效的，因为此评估的结果是两者之间的天数。时间是一天的一小部分。
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句