Excel VBA Outlook搜索多个标准（ID和日期）

Question

好吧，这是我的第二个线程，这是我遇到的VBA搜索难题。感谢那个帮我解决我的第一个问题的人。这个代码是从enter link description here

好吧，所以我作出调整，使其搜索一个SharedMailbox哪些工作，但问题是，邮箱每天接收数百电子邮件，使得搜索时间有点长我喜欢（我们从去年年初起还有电子邮件）。我想强加一个第二个搜索条件，这次是一个日期限制，就像只搜索2到3天的电子邮件一样。这里是我得到：

Dim outlookapp 
Dim olNs As Outlook.Namespace 
Dim Fldr As Outlook.MAPIFolder 
Dim olMail As Variant 
Dim myTasks 
Dim projIDsearch As String 
Dim myRecipient As Outlook.Recipient 
Dim days2ago As Date 



Set outlookapp = CreateObject("Outlook.Application") 
Set olNs = outlookapp.GetNamespace("MAPI") 
Set myRecipient = olNs.CreateRecipient("SharedMailboxName") 
myRecipient.Resolve 

'Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("x") 
Set Fldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox) 




Set myTasks = Fldr.Items 
projIDsearch = ActiveCell.Cells(1, 4) 


days2ago = DateTime.Now - 3 



For Each olMail In myTasks 

'If olMail.ReceivedTime > days2ago Then 


If (InStr(1, olMail.Subject, projIDsearch, vbTextCompare) > 0) Then 
olMail.Display 
'Exit For 
End If 


Next 

我环顾四周，发现.ReceivedTime属性。这听起来像我需要的东西，但我正在努力如何将它合并到代码中。实际上，我甚至不知道Variant（olMail）如何能够接受.display方法和.subject属性。

这些是我添加的代码，但他们似乎没有工作：在高级

days2ago = DateTime.Now - 3 

和

If olMail.ReceivedTime > days2ago Then 

感谢。

Answer 1

您可以限制循环中的项目数。 https://msdn.microsoft.com/en-us/library/office/ff869597.aspx

Sub test() 

Dim outlookapp As Object 
Dim olNs As Outlook.Namespace 

Dim myFldr As Outlook.Folder 
Dim objMail As Object 
Dim myTasks As Outlook.Items 

Dim daysAgo As Long 

Dim projIDsearch As String 
Dim myRecipient As Outlook.Recipient 

Set outlookapp = CreateObject("Outlook.Application") 
Set olNs = outlookapp.GetNamespace("MAPI") 
Set myRecipient = olNs.CreateRecipient("SharedMailboxName") 

myRecipient.Resolve 

Set myFldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox) 

projIDsearch = ActiveCell.Cells(1, 4) 

' Restrict search to daysAgo 
daysAgo = 3 

Set myTasks = myFldr.Items.Restrict("[ReceivedTime]>'" & Format(Date - daysAgo, "DDDDD HH:NN") & "'") 

For Each objMail In myTasks 

    If (InStr(1, objMail.Subject, projIDsearch, vbTextCompare) > 0) Then 
     objMail.Display 
    End If 

Next 

End Sub