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