Làm cách nào để tự động gắn cờ các email dựa trên tệp đính kèm cụ thể trong triển vọng?

Tác giả: Tiểu Dương Sửa đổi lần cuối: 2018-10-22

Khi nhận được một số email có tệp đính kèm quan trọng cụ thể, bạn có thể cần phải gắn cờ chúng để bạn có thể nhanh chóng và dễ dàng tìm thấy chúng cho quá trình xử lý. Bài viết này, tôi sẽ nói về một cách dễ dàng để tự động gắn cờ các email có tệp đính kèm với tên cụ thể.

Tự động gắn cờ các email dựa trên tệp đính kèm cụ thể với mã VBA

Tự động gắn cờ các email dựa trên tệp đính kèm cụ thể với mã VBA

Để tự động gắn cờ các email có chứa tệp đính kèm cụ thể, vui lòng áp dụng mã VBA sau:

1. Khởi chạy Outlook, rồi nhấn 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ế độ mới, sau đó sao chép và dán mã sau vào mô-đun trống.

Mã VBA: Tự động gắn cờ các email dựa trên tệp đính kèm cụ thể:

Public WithEvents GMailItems As Outlook.Items
Private Sub Application_Startup()
    Set GMailItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub GMailItems_ItemAdd(ByVal Item As Object)
    If Item.Class <> olMail Then Exit Sub
    FlagEmail_SpecificAttachments Item
End Sub

Sub FlagEmail_SpecificAttachments(Mail As Outlook.MailItem)
    Dim xAttachment As Outlook.Attachment
    Dim xExt As String
    Dim xFileName As String
    If Mail.Attachments.Count = 0 Then Exit Sub
    For Each xAttachment In Mail.Attachments
        xExt = SplitPath(xAttachment.FileName, 2)
        xFileName = SplitPath(xAttachment.FileName, 1)
        Select Case xExt
            Case "txt", "xlsx", "docx", "pdf"  'Add the file extension as you need
                If InStr(LCase(xFileName), LCase("KTO")) > 0 Then 'Change the text of the attachment name
                    With Mail
                        .ReminderSet = True
                        .ReminderTime = Now + 1
                        .MarkAsTask olMarkTomorrow
                        .Save
                    End With
                End If
        End Select
    Next
End Sub

Public Function SplitPath(FullPath As String, ResultFlag As Integer) As String
Dim xSplitPos As Integer, xDotPos As Integer
xSplitPos = InStrRev(FullPath, "/")
xDotPos = InStrRev(FullPath, ".")
Select Case ResultFlag
    Case 0
        SplitPath = Left(FullPath, xSplitPos - 1)
    Case 1
        If xDotPos = 0 Then xDotPos = Len(FullPath) + 1
        SplitPath = Mid(FullPath, xSplitPos + 1, xDotPos - xSplitPos - 1)
    Case 2
        If xDotPos = 0 Then xDotPos = Len(FullPath)
        SplitPath = Mid(FullPath, xDotPos + 1)
    Case Else
    Err.Raise vbObjectError + 1, "SplitPath Function", "Invalid Parameter!"
End Select
End Function

Chú thích: Trong đoạn mã trên, bạn có thể thay đổi phần mở rộng tệp và tên tệp đính kèm theo nhu cầu của mình.

3. Sau đó, lưu mã và khởi động lại Outlook để mã có hiệu lực, bây giờ, khi nhận được email có tên tệp đính kèm chứa văn bản được chỉ định, Outlook sẽ tự động gắn cờ email này để theo dõi, xem ảnh chụp màn hình: