Wie können E-Mails in Outlook automatisch anhand eines bestimmten Anhangs gekennzeichnet werden?

Wenn Sie E-Mails mit einem bestimmten wichtigen Anhang erhalten, möchten Sie diese vielleicht kennzeichnen, um sie später schnell und einfach für die Nachverfolgung wiederzufinden. In diesem Artikel zeige ich Ihnen eine einfache Methode, wie Sie E-Mails mit Anhängen bestimmter Namen automatisch kennzeichnen können.

E-Mails basierend auf einem bestimmten Anhang mithilfe von VBA-Code automatisch kennzeichnen

---

E-Mails basierend auf einem bestimmten Anhang mithilfe von VBA-Code automatisch kennzeichnen

Um E-Mails, die einen bestimmten Anhang enthalten, automatisch zu kennzeichnen, wenden Sie bitte den folgenden VBA-Code an:

1. Starten Sie Outlook und drücken Sie anschließend „ALT + F11“, um das Fenster „Microsoft Visual Basic for Applications“ zu öffnen.

2. Doppelklicken Sie im Fenster „Microsoft Visual Basic for Applications“ unter „Projekt1 (VbaProject.OTM)“ auf „ThisOutlookSession“, um ein neues Modul zu öffnen, und fügen Sie anschließend den folgenden Code in das leere Modul ein.

VBA-Code: Automatisches Kennzeichnen von E-Mails basierend auf einem bestimmten Anhang:

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

Hinweis: Im obigen Code können Sie Dateiname und Dateierweiterung des Anhangs ganz nach Ihren Anforderungen anpassen.

3. Speichern Sie den Code anschließend und starten Sie Outlook neu, damit die Änderung wirksam wird. Sobald Sie nun E-Mails erhalten, deren Anhänge den angegebenen Text im Dateinamen enthalten, markiert Outlook diese automatisch zur Nachverfolgung – siehe Screenshot: