Come spostare automaticamente le riunioni inviate in una cartella specifica in Outlook?

Normalmente, dopo aver inviato le e-mail o le riunioni, entrambe si troveranno nella cartella Posta inviata. Quindi, la cartella Posta inviata sarà notevolmente disordinata e ingombrante. In questo articolo, introdurrò un metodo per spostare automaticamente le riunioni inviate in un'altra cartella dopo l'invio della riunione.

Sposta automaticamente le riunioni inviate in una cartella specifica con codice VBA

Sposta automaticamente le riunioni inviate in una cartella specifica con codice VBA

Per spostare automaticamente tutti gli inviti alle riunioni inviati in un'altra cartella, il codice seguente può aiutarti, per favore fai come segue:

1. Tieni premuto il ALT + F11 chiavi per aprire il Microsoft Visual Basic, Applications Edition finestra.

2. Nel Microsoft Visual Basic, Applications Edition finestra, fare doppio clic Questa sessione di Outlook dal Progetto1 (VbaProject.OTM) riquadro per aprire la modalità, quindi copia e incolla il codice seguente nel modulo vuoto.

Codice VBA: sposta automaticamente le riunioni inviate in una cartella specifica

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. Quindi, salva e chiudi la finestra del codice. Ora, quando viene inviata un'e-mail di riunione, verrà spostata in una nuova cartella denominata Riunioni sotto il Oggetti inviati cartella automaticamente, vedi screenshot: