¿Cómo mover automáticamente las reuniones enviadas a una carpeta específica en Outlook?

Normalmente, después de enviar los correos electrónicos o las reuniones, ambos se ubicarán en la carpeta Elementos enviados. Por lo tanto, la carpeta Elementos enviados será considerablemente desordenada y engorrosa. En este artículo, presentaré un método para mover las reuniones enviadas a otra carpeta automáticamente después de que se envíe la reunión.

Mueva automáticamente las reuniones enviadas a una carpeta específica con código VBA

Mueva automáticamente las reuniones enviadas a una carpeta específica con código VBA

Para mover todas las invitaciones a reuniones enviadas a otra carpeta automáticamente, el siguiente código puede ayudarlo, haga lo siguiente:

1. Mantenga pulsado el ALT + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. En la Microsoft Visual Basic para aplicaciones ventana, haga doble clic Esta sesión de Outlook del desplegable Proyecto1 (VbaProject.OTM) panel para abrir el modo y luego copie y pegue el siguiente código en el módulo en blanco.

Código VBA: mueva automáticamente las reuniones enviadas a una carpeta específica

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 movimiento enviado reunión 1

3. Luego, guarde y cierre la ventana de código. Ahora, cuando se envía un correo electrónico de reunión, se moverá a una nueva carpeta llamada Reuniones bajo el Elementos enviados carpeta automáticamente, vea la captura de pantalla:

doc movimiento enviado reunión 2