如何在 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 将自动为该邮件添加跟进标记，如下图所示：