Adam
Adam

Reputation: 25

Why does the Application.AdvancedSearch method fail to operate?

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

Upvotes: 0

Views: 476

Answers (1)

niton
niton

Reputation: 9209

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

Upvotes: 1

Related Questions