如何在 Outlook 中自动将已发送的会议移动到指定文件夹？

通常，发送邮件或会议后，它们都会被保存在已发送邮件文件夹中，导致该文件夹变得杂乱且难以管理。本文将为您介绍一种方法，帮助您在会议发送后，自动将已发送的会议移动到其他文件夹中。

使用 VBA 代码自动将已发送的会议移动到指定文件夹

---

使用 VBA 代码自动将已发送的会议移动到指定文件夹

要自动将所有已发送的会议邀请移动到其他文件夹，可以使用以下代码，请操作如下：

1. 按住 ALT + F11 键，即可打开 Microsoft Visual Basic for Applications 窗口。

2. 在 Microsoft Visual Basic for Applications 窗口中，双击 Project 1(VbaProject.OTM) 窗格下方的 ThisOutlookSession，打开该模块，然后将以下代码复制粘贴到空白模块中。

VBA 代码：自动将已发送的会议移动到指定文件夹

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. 然后，保存并关闭代码窗口。此后，每当会议邮件发送后，系统会自动将其移动到已发送邮件文件夹下名为 Meetings 的文件夹中，请参见截图：