Come spostare automaticamente gli inviti a riunioni inviati in una cartella specifica in Outlook?

Di norma, sia le email che gli inviti a riunioni vengono salvati nella cartella **Elementi inviati** dopo l’invio, rendendola rapidamente disordinata e difficile da gestire. In questo articolo ti mostrerò un metodo per spostare automaticamente gli inviti a riunione inviati in un’altra cartella non appena vengono inviati.

Spostare automaticamente gli inviti a riunione inviati in una cartella specifica con codice VBA

---

Spostare automaticamente gli inviti a riunione inviati in una cartella specifica con codice VBA

Per spostare automaticamente tutti gli inviti a riunione in un’altra cartella, puoi utilizzare il seguente codice. Procedi nel modo seguente:

1. Tieni premuti i tasti ALT + F11 per aprire la finestra di Microsoft Visual Basic for Applications.

2. Nella finestra di Microsoft Visual Basic for Applications, fai doppio clic su ThisOutlookSession nel riquadro Project1 (VbaProject.OTM) per aprire il modulo, quindi copia e incolla il seguente codice nel modulo vuoto.

Codice VBA: Sposta automaticamente gli inviti a riunione inviati 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. Da ora in poi, ogni volta che invii un invito a riunione, verrà spostato automaticamente in una nuova cartella denominata Meetings, situata sotto la cartella Elementi inviati. Vedere lo screenshot: