Làm cách nào để tự động di chuyển các cuộc họp đã gửi đến một thư mục cụ thể trong Outlook?

Thông thường, sau khi gửi email hoặc cuộc họp, cả hai sẽ được đặt trong thư mục Mục đã Gửi. Vì vậy, thư mục Sent Items sẽ rất lộn xộn và cồng kềnh. Bài viết này, tôi sẽ giới thiệu một phương pháp để tự động di chuyển các cuộc họp đã gửi sang một thư mục khác sau khi cuộc họp được gửi đi.

Tự động di chuyển các cuộc họp đã gửi đến một thư mục cụ thể với mã VBA

Tự động di chuyển các cuộc họp đã gửi đến một thư mục cụ thể với mã VBA

Để tự động di chuyển tất cả các lời mời họp đã gửi sang một thư mục khác, mã sau có thể giúp bạn, vui lòng thực hiện như sau:

1. Giữ ALT + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. Trong Microsoft Visual Basic cho các ứng dụng cửa sổ, nhấp đúp ĐâyOutlookSession từ Project1 (VbaProject.OTM) để mở chế độ, sau đó sao chép và dán mã sau vào mô-đun trống.

Mã VBA: Tự động di chuyển các cuộc họp đã gửi vào một thư mục cụ thể

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 di chuyển đã gửi cuộc họp 1

3. Sau đó, lưu và đóng cửa sổ mã. Bây giờ, khi một email cuộc họp được gửi đi, nó sẽ được chuyển đến một thư mục mới có tên Các cuộc họp theo Các mục đã gửi thư mục tự động, xem ảnh chụp màn hình:

doc di chuyển đã gửi cuộc họp 2