如何根據 Outlook 中的特定附件自動為郵件加上標記？

當您收到某些附帶特定重要附件的郵件時，不妨將其標記出來，日後便能快速輕鬆地找到這些郵件並進行跟進。本文將為您介紹一種簡單方法，可自動標記附件名稱符合特定條件的郵件。

使用 VBA 程式碼根據特定附件自動標記郵件

---

使用 VBA 程式碼根據特定附件自動標記郵件

若要自動標記包含特定附件的郵件，請套用以下 VBA 程式碼：

1. 啟動 Outlook，然後按住「Alt + F11」鍵，即可開啟「Microsoft Visual Basic for Applications」視窗。

2. 在「Microsoft Visual Basic for Applications」視窗中，於「Project 1 （VbaProject.OTM）」窗格內雙擊「ThisOutlookSession」以開啟新模組，並將下列程式碼複製貼上至空白模組中。

VBA 程式碼：根據特定附件自動標記郵件：

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"
                If InStr(LCase(xFileName), LCase("KTO")) > 0 Then
                    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

注意：在上述程式碼中，您可依需求變更副檔名及附件檔案名稱。

3. 接著儲存程式碼並重新啟動 Outlook，讓設定立即生效。此後，只要收到附件檔名包含指定文字的郵件，Outlook 就會自動為該郵件加上旗標，方便您後續追蹤，如下圖所示：