Why does the Application.AdvancedSearch method fail to operate? - vba

Question

The below subroutine runs upon Outlook application startup with the Application level event "Startup". The sub accesses an Outlook NoteItem with a time stamp used to filter all items in the Outlook account parent folder received since the last time Outlook was closed with the Application.AdvancedSearch method. The resulting items of the search will then be processed in a separate subroutine.
The code is failing on the Application.AdvancedSearch line. I have tried changing the scope (the first field) to the inbox (see the commented out line). Either way, the operation fails.
Why is the operation failing?
Thanks for the help!
Option Explicit
Public Sub Process_New_Items()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim dmi As MailItem
Dim timeFol As Outlook.Folder
Dim timeFilter As String
Dim lastclose As String
Dim utcdate As Date
Dim filterString As String
Dim i As Object
Dim subFol As Outlook.Folder
Dim olFol
Dim asFilter As String
Dim Scope As String
Dim SearchObject As Outlook.Search
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFol = olNS.Folders(1)
Set dmi = olApp.CreateItem(olMailItem)
Set timeFol = olNS.GetDefaultFolder(olFolderNotes)
timeFilter = "[Subject] = 'App Close Time'"
For Each i In timeFol.Items.Restrict(timeFilter)
lastclose = i.CreationTime
Next i
utcdate = dmi.PropertyAccessor.LocalTimeToUTC(lastclose)
filterString = "#SQL=""urn:schemas:httpmail:datereceived"" >= '" & Format(utcdate, "dd mmm yyyy hh:mm") & "'"
asFilter = "urn:schemas:httpmail:datereceived >= '" & Format(utcdate, "dd mmm yyyy hh:mm") & "'"
Scope = "'" & olNS.Folders(1) & "'"
'Scope = "'Inbox', 'Sent Items', 'Tasks'"
SearchObject = olApp.AdvancedSearch(Scope, filterString, True)
For Each i In SearchObject.Results
If TypeName(i) = "MailItem" Then
Process_MailItem i
Else: End If
Next i
End Sub

Answer 1

The filter is "urn:schemas:httpmail:datereceived >= " & "'" & utcdate & "'"
Option Explicit
' Code in ThisOutlookSession
Public blnSearchComp As Boolean
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
' https://learn.microsoft.com/en-us/office/vba/api/outlook.application.advancedsearch
' Code should be in a class module such as ThisOutlookSession
Debug.Print "The AdvancedSearchComplete Event fired"
If SearchObject.Tag = "Process_New_Items" Then
'm_SearchComplete = True` ' Use Option Explicit.
blnSearchComp = True
End If
End Sub
Private Sub Process_New_Items()
Dim dmi As mailItem
Dim timeFol As Folder
Dim timeFilter As String
Dim lastclose As String
Dim utcdate As Date
Dim strFilter As String
Dim i As Object
Dim strScope As String
Dim SearchObject As Search
Set dmi = CreateItem(olMailItem)
Set timeFol = Session.GetDefaultFolder(olFolderNotes)
timeFilter = "[Subject] = 'App Close Time'"
For Each i In timeFol.Items.Restrict(timeFilter)
lastclose = i.CreationTime
Next i
Debug.Print lastclose
utcdate = dmi.propertyAccessor.LocalTimeToUTC(lastclose)
'strFilter = "#SQL=""urn:schemas:httpmail:datereceived"" >= '" & Format(utcdate, "dd mmm yyyy hh:mm") & "'"
strFilter = "urn:schemas:httpmail:datereceived >= " & "'" & utcdate & "'"
Debug.Print strFilter
strScope = "'" & Session.Folders(1).Folders("Inbox") & "'"
Debug.Print strScope
strScope = "'" & Session.GetDefaultFolder(olFolderInbox) & "'"
Debug.Print strScope
strScope = "'Inbox'"
Debug.Print strScope
' mailbox: to include folders at the same level as the Inbox
strScope = "'" & Session.GetDefaultFolder(olFolderInbox).Parent.folderPath & "'"
Debug.Print "strScope.: " & strScope
Set SearchObject = AdvancedSearch(Scope:=strScope, filter:=strFilter, SearchSubFolders:=True, Tag:="Process_New_Items")
' 2022-07-01 Eureka!
blnSearchComp = False
' Otherwise remains True.
' Search would work once until Outlook restarted.
While blnSearchComp = False
DoEvents
' Code should be in a class module such as ThisOutlookSession
Debug.Print "Wait a few seconds. Ctrl + Break if needed."
Wend
Debug.Print "SearchObject.results.count: " & SearchObject.results.count
For Each i In SearchObject.results
If TypeName(i) = "MailItem" Then
'Process_MailItem i
Debug.Print i.ReceivedTime, i.subject
Else: End If
Next i
End Sub