0

This code was derived from Excel VBA for searching in mails of Outlook.

I made adjustments to make it search a SharedMailbox which does work but the issue is that the mailbox is receiving hundreds of emails a day which makes searching time a bit longer for my liking (we have emails from early last year even). I would like to impose a 2nd search criteria, this time a date limit, like only search emails that are 2 to 3 days old.

Here is what I got:

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

I've looked around and found the .ReceivedTime property, which sounds like the thing that I need but I'm having a struggle on how to incorporate it into the code.

Actually I don't even know how a Variant(olMail) is able to accept the .display method and .subject property.

These are the codes that I've added but they don't seem to work:

days2ago = DateTime.Now - 3

and

If olMail.ReceivedTime > days2ago Then
mkrieger1
  • 19,194
  • 5
  • 54
  • 65
wh3resmycar2
  • 191
  • 1
  • 13

1 Answers1

1

You can Restrict the number of items in the loop. 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
niton
  • 8,771
  • 21
  • 32
  • 52
  • it looks neat and it works. thanks man. what if i need another filter? let's say a string in the Subject line of an email for example it will look for "Record 1"? do i create another myTasks restriction or can i add .Restrict("Subject" Contains "Record 1") to the current myTasks? – wh3resmycar2 Mar 01 '17 at 20:21
  • The link states "Logical operators that are allowed are AND, OR, and NOT". You can as well restrict twice. I do not know of a way to get "Contains" in a Restrict. – niton Mar 01 '17 at 20:40
  • twice restrict means 2 loops? can you give an example please? – wh3resmycar2 Mar 02 '17 at 18:46
  • For the second filter Set myTasks =myTasks.Restrict – niton Mar 02 '17 at 19:35