Outlook - GetSharedDefaultFolder

Bonjour,

J'ai fais une macro sous Outlook 2019, afin de pouvoir exécuter des règles à la demande pour des dossiers choisis sur une boite email partagée.

Hors je me trouve bloqué par une erreur liée à la désignation du dossier dans lequel je souhaite que la règle s’exécute. Je précise qu'il y 'a plusieurs niveaux de sous-dossier situés dans l'Inbox.

J'ai essayé plusieurs syntaxes mais ça ne fonctionne pas "Impossible de trouver un objet":

Soit

Folder:=NS.GetSharedDefaultFolder(objOwner, olFolderInbox).Folders("01-Dossier").Folders("CLIENT").Folders("PROJET")

Soit au préalable

Set FolderA = Ns.GetSharedDefaultFolder(objOwner, olFolderInbox)

Set FolderB = FolderA.Folders("01-Dossier")

Set FolderC = FolderB.Folders("CLIENT")

Set FolderD = FolderC.Folders("PROJET")

Et j'appelle ensuite le FolderD sur l'exécution de la règle.

Mais ça bloque au FolderB pour la même raison de "Impossible de trouver un objet"

Si je résume, il n'arrive pas à identifier les sous-dossiers à l'Inbox. Et les noms sont corrects.

Pour info j'ai essayé pour la boite email par défaut et ça marche bien, mais pas pour la boite partagée.

Ci-dessous le code.

Merci de votre aide

Cdt

Sub Essai()

Dim Ns As Outlook.NameSpace
Dim oStore As Outlook.Store
Dim olRules As Outlook.Rules
Dim myRule As Outlook.Rule
Dim olRuleNames() As Variant
Dim name As Variant
Dim objOwner As Outlook.Recipient

Set Ns = Application.GetNamespace("MAPI")
Set objOwner = Ns.CreateRecipient("Maintenance")
    objOwner.Resolve

 If objOwner.Resolved Then
 Set newInboxFolder = Ns.GetSharedDefaultFolder(objOwner, olFolderInbox)
 End If

' rules you want to run
olRuleNames = Array("TestRemi")

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, Folder:=NS.GetSharedDefaultFolder(objOwner, olFolderInbox).Folders("01-Dossier").Folders("CLIENT").Folders("PROJET"), IncludeSubfolders:=False, RuleExecuteOption:=2
        End If
    Next
Next

End Sub