Outlook で送信済みの会議招待状を特定のフォルダーに自動的に移動するには？

通常、メールや会議の送信後はどちらも「送信済みアイテム」フォルダーに保存されるため、「送信済みアイテム」フォルダーは非常に散らかり、使いづらくなります。本記事では、会議を送信した後に送信済みの会議アイテムを別のフォルダーに自動的に移動させる方法をご紹介します。

VBA コードで送信済みの会議を特定のフォルダーに自動的に移動

---

VBA コードで送信済みの会議を特定のフォルダーに自動的に移動

送信済みのすべての会議招待状を自動的に別のフォルダーに移動させるには、以下のコードが役立ちます。次の手順に従ってください。

1．ALT + F11キーを押すと、Microsoft Visual Basic for Applicationsウィンドウが開きます。

2．Microsoft Visual Basic for Applicationsウィンドウで、Project1 (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という名前の新しいフォルダに移動されます（スクリーンショット参照）。