Como mover automaticamente reuniões enviadas para uma pasta específica no Outlook?
Normalmente, após o envio de e-mails ou reuniões, ambos serão localizados na pasta Itens Enviados. Assim, a pasta Itens Enviados ficará consideravelmente bagunçada e complicada de gerenciar. Neste artigo, vou apresentar um método para mover as reuniões enviadas para outra pasta automaticamente após o envio da reunião.
Mover automaticamente as reuniões enviadas para uma pasta específica com código VBA
Mover automaticamente as reuniões enviadas para uma pasta específica com código VBA
Para mover todos os convites de reunião enviados automaticamente para outra pasta, o seguinte código pode ajudá-lo; por favor, faça o seguinte:
1. Pressione e segure as teclas ALT + F11 para abrir a janela do Microsoft Visual Basic for Applications.
2. Na janela do Microsoft Visual Basic for Applications, clique duas vezes em ThisOutlookSession no painel Project1(VbaProject.OTM) para abrir o modo, e depois copie e cole o seguinte código no módulo em branco.
Código VBA: Mover 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
3. Em seguida, salve e feche a janela do código. Agora, quando um e-mail de reunião for enviado, ele será movido automaticamente para uma nova pasta chamada Reuniões dentro da pasta Itens Enviados, veja a captura de tela:
Melhores Ferramentas de Produtividade para Office
Notícia Urgente: Kutools para Outlook lança versão gratuita!
Experimente o novo Kutools para Outlook com mais de100 recursos incríveis! Clique para baixar agora!
📧 Automação de Email: Resposta automática (Disponível para POP e IMAP) / Agendar envio de emails / CC/BCC automático por regra ao enviar email / Encaminhamento automático (Regra avançada) / Adicionar saudação automaticamente / Dividir automaticamente emails com vários destinatários em mensagens individuais...
📨 Gerenciamento de Email: Recallar Email / Bloquear emails suspeitos por assunto e outros critérios / Excluir emails duplicados / Pesquisa Avançada / Organizar Pastas...
📁 Anexos Pro: Salvar em lote / Desanexar em lote / Comprimir em lote / Salvar automaticamente / Desanexar automaticamente / Auto Comprimir...
🌟 Interface Mágica: 😊Mais emojis bonitos e divertidos / Aviso de chegada de emails importantes / Minimizar Outlook em vez de fechar...
👍 Praticidade com um clique: Responder a Todos com Anexos / Anti-Phishing Emails / 🕘Exibir fuso horário do remetente...
👩🏼🤝👩🏻 Contatos & Calendário: Adicionar contatos em lote a partir de emails selecionados / Dividir um grupo de contatos em grupos individuais / Remover lembrete de aniversário...
Use o Kutools no idioma que preferir – compatível com Inglês, Espanhol, Alemão, Francês, Chinês e mais de40 outros!
