Como mover automaticamente reuniões enviadas para uma pasta específica no Outlook?

Normalmente, após o envio dos e-mails ou reuniões, ambos ficarão localizados na pasta Itens Enviados. Portanto, a pasta Itens Enviados ficará consideravelmente confusa e complicada. Neste artigo, apresentarei um método para mover as reuniões enviadas para outra pasta automaticamente após o envio da reunião.

Mova automaticamente as reuniões enviadas para uma pasta específica com código VBA

Mova automaticamente as reuniões enviadas para uma pasta específica com código VBA

Para mover todos os convites de reunião enviados para outra pasta automaticamente, o código a seguir pode ajudá-lo, faça o seguinte:

1. Segure o ALT + F11 chaves para abrir o Microsoft Visual Basic para Aplicações janela.

2. No Microsoft Visual Basic para Aplicações janela, clique duplo Esta sessão do Outlook do Projeto1 (VbaProject.OTM) painel para abrir o modo e, em seguida, copie e cole o código a seguir no módulo em branco.

Código VBA: mova automaticamente as reuniões enviadas para uma pasta 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 mover reunião enviada 1

3. Em seguida, salve e feche a janela de código. Agora, quando um e-mail de reunião for enviado, ele será movido para uma nova pasta chamada Reuniões sob a Itens enviados pasta automaticamente, veja a captura de tela:

doc mover reunião enviada 2