Comment déplacer automatiquement les réunions reçues vers un dossier spécifique dans Outlook ?

Normalement, après l’envoi des e-mails ou des réunions, les deux sont placés dans le dossier Éléments envoyés. Le dossier Éléments envoyés devient donc considérablement désorganisé et encombré. Dans cet article, je vais vous présenter une méthode permettant de déplacer automatiquement les réunions envoyées vers un autre dossier dès leur envoi.

Déplacer automatiquement les réunions envoyées vers un dossier spécifique à l’aide d’un code VBA

---

Déplacer automatiquement les réunions envoyées vers un dossier spécifique à l’aide d’un code VBA

Pour déplacer automatiquement toutes les invitations à des réunions reçues vers un autre dossier, le code suivant vous sera utile. Procédez comme suit :

1. Maintenez enfoncées les touches ALT + F11 pour ouvrir la fenêtre Microsoft Visual Basic pour Applications.

2. Dans la fenêtre Microsoft Visual Basic pour Applications, double-cliquez sur ThisOutlookSession dans le volet Projet1 (VbaProject.OTM) pour ouvrir le module, puis copiez-collez le code suivant dans le module vide.

Code VBA : Déplacer automatiquement les réunions envoyées vers un dossier spécifique

Private WithEvents GExplorer As Outlook.Explorer
Public WithEvents GSentFolder As Outlook.Folder
Public WithEvents GSentItems As Outlook.Items
Private Sub Application_Startup()
    Set GExplorer = Outlook.Application.ActiveExplorer
End Sub
Private Sub GExplorer_SelectionChange()
Dim xFolder As Folder, xRootFolder As Folder
Dim xRootFldName As String
Dim xPos As Integer
    On Error Resume Next
    Set xFolder = Outlook.Application.ActiveExplorer.CurrentFolder
    xPos = VBA.InStr(3, xFolder.FolderPath, "\")
    If xPos > 0 Then
        xRootFldName = VBA.Mid(xFolder.FolderPath, 3, xPos - 3)
    Else
        xRootFldName = VBA.Mid(xFolder.FolderPath, 3, Len(xFolder.FolderPath) - 2)
    End If
    Set xRootFolder = Outlook.Application.Session.Folders(xRootFldName)
    Set GSentFolder = xRootFolder.Folders("Sent Items")
    Set GSentItems = GSentFolder.Items
End Sub
Private Sub GSentItems_ItemAdd(ByVal Item As Object)
    Dim xMeetingItem As Outlook.MeetingItem
    Dim xTargetFolder As Outlook.Folder
    On Error Resume Next
    If Item.Class <> olMeetingRequest Then Exit Sub
    Set xMeetingItem = Item
    Set xTargetFolder = GSentFolder.Folders("Meetings")
    If xTargetFolder Is Nothing Then
        Set xTargetFolder = GSentFolder.Folders.Add("Meetings")
    End If
    xMeetingItem.Move xTargetFolder
End Sub

3. Ensuite, sauvegardez et fermez la fenêtre de code. Désormais, lorsqu’un e-mail de réunion est envoyé, il sera automatiquement déplacé vers un nouveau dossier nommé Meetings, situé sous le dossier Éléments envoyés, comme illustré ci-dessous :