Hvordan flytter jeg automatisk sendte møder til en bestemt mappe i Outlook?

Forfatter: Xiaoyang Sidst ændret: 2018-11-29

Efter afsendelse af e-mails eller møder placeres begge normalt i mappen Sendte poster. Så mappen Sendte poster vil være betydeligt rodet og besværlig. Denne artikel vil jeg introducere en metode til automatisk at flytte de sendte møder til en anden mappe, efter at mødet er sendt ud.

Flyt automatisk de sendte møder til en bestemt mappe med VBA-kode

Flyt automatisk de sendte møder til en bestemt mappe med VBA-kode

For at flytte alle sendte mødeinvitationer til en anden mappe automatisk, kan følgende kode hjælpe dig, gør som følger:

1. Hold nede ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. I Microsoft Visual Basic til applikationer dobbeltklik på vinduet Denne OutlookSession fra Project1 (VbaProject.OTM) rude for at åbne tilstanden og derefter kopiere og indsætte følgende kode i det tomme modul.

VBA-kode: Flyt automatisk de sendte møder til en bestemt mappe

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 move sendt møde 1

3. Gem derefter og luk kodevinduet. Når en mødemail sendes ud, flyttes den nu til en ny mappe med navnet Møder under Sendte ting mappe automatisk, se skærmbillede:

doc move sendt møde 2