I have a VBA script that needs to run upon application startup, but after client rules are processed.
I did what was suggested here: How can I tell when Rules have finished processing?
I added the executing of all rules in Outlook before the rest of the script runs. It did not solve my issue. My script only can process new emails that are in the inbox, not ones that have a rule applied to them. The AdvancedSearch
method does not pick them up, even after adding the rule execution lines before.
Option Explicit
Public blnSearchComp As Boolean
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
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 Application_Startup()
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
'----------------------------------------------------------------------
Dim olRules As Outlook.Rules
Dim myRule As Outlook.Rule
Set olRules = Application.Session.DefaultStore.GetRules()
For Each myRule In olRules
' Rules we want to run
myRule.Execute
Next
'----------------------------------------------------------------------
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
'strScope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).FolderPath & "'"
'Sleep (20)
Set SearchObject = AdvancedSearch(Scope:=strScope, Filter:=strFilter, SearchSubFolders:=True, Tag:="Process_New_Items")
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