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 = "sharedmailbox@abcxyz.zz"
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
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 = "sharedmailbox@abcxyz.zz"
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