Comment déplacer automatiquement les réunions envoyées vers un dossier spécifique dans Outlook?

Normalement, après l'envoi des e-mails ou des réunions, les deux seront situés dans le dossier Éléments envoyés. Ainsi, le dossier Éléments envoyés sera considérablement désordonné et encombrant. Cet article, je vais vous présenter une méthode pour déplacer automatiquement les réunions envoyées vers un autre dossier après l'envoi de la réunion.

Déplacer automatiquement les réunions envoyées vers un dossier spécifique avec le code VBA

Déplacer automatiquement les réunions envoyées vers un dossier spécifique avec le code VBA

Pour déplacer automatiquement toutes les invitations à des réunions envoyées vers un autre dossier, le code suivant peut vous aider, procédez comme suit:

1. Maintenez le ALT + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2. Dans le Microsoft Visual Basic pour applications fenêtre, double-cliquez Cette session Outlook du Projet1 (VbaProject.OTM) volet pour ouvrir le mode, puis copiez et collez le code suivant dans le module vide.

Code VBA: déplacez 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

doc move a envoyé la réunion 1

3. Ensuite, enregistrez et fermez la fenêtre de code. Désormais, lorsqu'un e-mail de réunion est envoyé, il sera déplacé vers un nouveau dossier nommé Réunions sous le Éléments envoyés dossier automatiquement, voir capture d'écran:

doc move a envoyé la réunion 2