Run code upon application startup, but after client rules are processed - vba

Question

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

Answer 1

You can use built-in Windows mechanisms via Windows API functions like SetTimer to set up a timer in VBA, see How to make safe API Timers in VBA? and Outlook VBA - Run a code every half an hour for more information. For example:
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running
Public Sub ActivateTimer(ByVal nMinutes As Long)
nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes
If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer
TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer)
If TimerID = 0 Then
MsgBox "The timer failed to activate."
End If
End Sub
Public Sub DeactivateTimer()
Dim lSuccess As Long
lSuccess = KillTimer(0, TimerID)
If lSuccess = 0 Then
MsgBox "The timer failed to deactivate."
Else
TimerID = 0
End If
End Sub
Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
MsgBox "The TriggerTimer function has been automatically called!"
End Sub