Comment déplacer un e-mail dans Outlook vers un sous-dossier?

Question

J'essaie de créer une macro qui déplacera des éléments dans ma boîte de réception Outlook vers un sous-dossier d'un autre dossier au même niveau que la boîte de réception (le dossier parent n'est pas un sous-dossier de la boîte de réception). Voici le code que je utilise:

Sub EventRequests() 
On Error Resume Next 

Dim ns As Outlook.NameSpace 
Dim moveToFolder As Outlook.MAPIFolder 
Dim objItem As Outlook.MailItem 

Set ns = Application.GetNamespace("MAPI") 

'Define path to the target folder 
Set moveToFolder = ns.Folders("Events").Folders("Event Requests") 

If Application.ActiveExplorer.Selection.Count = 0 Then 
    MsgBox ("Select an E-mail first") 
    Exit Sub 
End If 

If moveToFolder Is Nothing Then 
    MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error" 
End If 

For Each objItem In Application.ActiveExplorer.Selection 
    If moveToFolder.DefaultItemType = olMailItem Then 
     If objItem.Class = olMail Then 
     objItem.Move moveToFolder 
     End If 
    End If 
Next 

Set objItem = Nothing 
Set moveToFolder = Nothing 
Set ns = Nothing 
End Sub 

Quand je lance le code que je reçois une erreur qui dit « dossier cible not found! » J'ai essayé Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Folders("Events").Folders("Event Requests") et Set MoveToFolder = ns.Folders("Mailbox - my name").Folders(targetFolder) mais aucun de ceux qui ont travaillé. J'ai un autre up jeu macro qui déplace les messages dans ma boîte de réception dans un dossier qui est un sous-dossier de ma boîte de réception et il fonctionne très bien:

Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Folders("Completed") 

Comment puis-je fixer le chemin cible de sorte qu'il pointe vers le sous-dossier correct ?

Answer 1

Je vais aller de l'avant et après une réponse à ma propre question de sorte que si d'autres personnes à l'avenir ont ce problème, ils peuvent voir le code je suis arrivé à cela fonctionne:

Sub EventRequests() 

Dim ns As Outlook.NameSpace 
Dim moveToFolder As Outlook.MAPIFolder 
Dim objItem As Outlook.MailItem 

Set ns = Application.GetNamespace("MAPI") 

On Error GoTo 0 
Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Parent.Folders("Events").Folders("Event Requests") 


If Application.ActiveExplorer.Selection.Count = 0 Then 
    MsgBox ("Select an E-mail first") 
    Exit Sub 
End If 

If moveToFolder Is Nothing Then 
    MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error" 
End If 

For Each objItem In Application.ActiveExplorer.Selection 
    If moveToFolder.DefaultItemType = olMailItem Then 
     If objItem.Class = olMail Then 
     objItem.Move moveToFolder 
     End If 
    End If 
Next 

Set objItem = Nothing 
Set moveToFolder = Nothing 
Set ns = Nothing 
End Sub