Xtykutl

Trying to run a simple rule to move emails upon arrival from first public email box to second public email box (Rule is: Apply this rule after the message arrives | Sent to "first public email box" | move it to the "second public email box" folder). Rule works when run manually but the rule does not work automatically upon emails arriving (research shows there might be some corrupt file, blah blah). Trying to make it work via VBA instead. Below macro supposed to run the rules upon a reminder popping up. Reminder pops up, but rules don't run. Running that macro from a QAT custom button, brings up progress window, and that window shows progress, but emails are still in the first public email box.

Private Sub Application_Reminder(ByVal Item As Object)



If Item.MessageClass <> "IPM.Task" Then

  Exit Sub

End If



If Item.Subject = "Run Rules" Then

  RunRules

End If



End Sub



Sub RunRules()



Dim olRules As Outlook.Rules

Dim myRule As Outlook.Rule

Dim olRuleNames() As Variant

Dim name As Variant



olRuleNames = Array("Rule A", "Rule B")



Set olRules = Application.Session.DefaultStore.GetRules()



For Each name In olRuleNames()

    For Each myRule In olRules

    ' Rules we want to run

        If myRule.name = name Then

        myRule.Execute ShowProgress:=True

        End If

    Next

Next

End Sub

The use of DefaultStore is a hint there are stores other than the default.

Set olRules = Application.Session.DefaultStore.GetRules()

Option Explicit



Private Sub FindStoreWithRules()



Dim colStores As stores

Dim oStore As store



Dim olRules As rules

Dim myRule As Rule



Dim i As Long



Set colStores = Session.stores



For i = 1 To colStores.count



    Debug.Print i & ": " & colStores(i)



    ' On second run

    ' Enter applicable name then uncomment this line and the End If

    ' If colStores(i) = "Name of store shown in immediate window" Then



        On Error Resume Next

        ' Where rules not applicable on some stores there is an error.

        Set olRules = colStores(i).GetRules()

        ' Discontinue error bypass as soon as the purpose is served

        On Error GoTo 0



        If Not olRules Is Nothing Then

            For Each myRule In olRules

                ' Uncomment on second run to see if what rules were found

                'Debug.Print " - " & myRule.name

            Next

        Else

            Debug.Print "Rules not applicable in " & colStores(i)

        End If



    ' End If



Next



Debug.Print "Done."



End Sub