0

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
Community
  • 1
  • 1
Adam
  • 25
  • 5
  • I could not recreate "My script only can **process new emails that are in the inbox**, not ones that have a rule applied to them." In my setup **no incoming items** are found. My `inboxItms_ItemAdd` does not trigger until `Application_Startup()` finishes. – niton Aug 12 '22 at 23:07
  • 1
    If Outlook does not make incoming mail available until `Application_Startup()` finishes then you could try [Running Outlook Macros on a Schedule: How do I run a macro 5 minutes after Outlook starts?](https://www.slipstick.com/developer/code-samples/running-outlook-macros-schedule/) – niton Aug 13 '22 at 20:26
  • @niton, This appears to work well. At least, the closest I can get to what I need. This works in conjunction with the code from my question. Thanks for the article link! – Adam Aug 23 '22 at 13:03

1 Answers1

0

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
Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
  • What would be the benefit of an API timer? The current issue I am facing has to do with why, when I execute the rules in Outlook in the beginning of my code, are the new emails that are sorted to subfolders still not getting picked up in the `AdvancedSearch` method's search. Can you speak to that? Thanks for your answer. – Adam Aug 11 '22 at 18:44