Outlook macro not writing to shared mailbox

Question

The following macro creates an Outlook rule correctly, but only in my private email account, not in the shared mailbox I am targeting. Can someone please identify any errors/omissions in the code that are causing it not to link to the shared mailbox?

Sub CreateRule_MSmodified5()
'Creates rule in private folder, not shared mailbox

Dim sharedMailboxName As String
sharedMailboxName = "[email protected]"

Dim olApp As Object
Set olApp = Outlook.Application
Dim olNamespace As Outlook.NameSpace
Set olNamespace = olApp.GetNamespace("MAPI")

Dim olRecipient As Outlook.Recipient
Set olRecipient = olNamespace.CreateRecipient(sharedMailboxName)
olRecipient.Resolve

Dim oInbox As Outlook.Folder
If olRecipient.Resolved Then
    Set oInbox = olNamespace.GetSharedDefaultFolder(olRecipient, olFolderInbox)
End If

Dim oMoveTarget As Outlook.Folder
Set oMoveTarget = oInbox.Folders("Test")

Dim colRules As Outlook.Rules
Set colRules = olNamespace.DefaultStore.GetRules()
Dim oRule As Outlook.Rule
Set oRule = colRules.Create("C5", olRuleReceive)
  
Dim oMoveRuleAction As Outlook.MoveOrCopyRuleAction
Set oMoveRuleAction = oRule.Actions.MoveToFolder
With oMoveRuleAction
    .Enabled = True
    .Folder = oMoveTarget
End With

Dim oExceptSubject As Outlook.TextRuleCondition
Set oExceptSubject = oRule.Exceptions.Subject
With oExceptSubject
    .Enabled = True
    .Text = Array("string1", "string2")
End With

colRules.Save

End Sub

Answer 1

Whether saving to another store is feasible, "technically" you need the non-default store.

It could look like this.

Option Explicit

Sub CreateRule_MSmodified5_nondefaultStore()

Dim sharedMailboxName As String
sharedMailboxName = "[email protected]"

Dim olNamespace As namespace
Set olNamespace = GetNamespace("MAPI")

Dim olRecipient As Recipient
Set olRecipient = olNamespace.CreateRecipient(sharedMailboxName)
olRecipient.Resolve

Dim oInbox As folder
'Email address is always resolved. Use when not an email address.
If olRecipient.Resolved Then   
    Set oInbox = olNamespace.GetSharedDefaultFolder(olRecipient, olFolderInbox)
End If

Dim oMoveTarget As folder
Set oMoveTarget = oInbox.Folders("Test")

Dim colRules As Rules

Dim i As Long
For i = 1 To Session.Stores.count

    Debug.Print Session.Stores(i)
    
    If Session.Stores(i) = sharedMailboxName Then

        Set colRules = Session.Stores(i).GetRules()
        
        Dim oRule As Rule
        Set oRule = colRules.Create("C5", olRuleReceive)
          
        Dim oMoveRuleAction As MoveOrCopyRuleAction
        Set oMoveRuleAction = oRule.Actions.MoveToFolder
        With oMoveRuleAction
            .Enabled = True
            .folder = oMoveTarget
        End With
        
        Dim oExceptSubject As TextRuleCondition
        Set oExceptSubject = oRule.Exceptions.subject
        With oExceptSubject
            .Enabled = True
            .Text = Array("string1", "string2")
        End With
        
        colRules.Save
        
        Exit For
        
    End If
Next

End Sub