Outlook’ta belirli bir ek dosyaya sahip e-postaları otomatik olarak nasıl işaretleyebilirim?

Bazı e-postalar, belirli önemli ek dosyalar içerdiğinde, bunları takip edebilmek ve gerektiğinde hızlıca bulabilmek için işaretlemeniz gerekebilir. Bu makalede, belirli isimlere sahip ekleri olan e-postaları otomatik olarak nasıl kolayca işaretleyebileceğinizi anlatacağım.

Belirli bir ek dosyaya göre e-postaları VBA koduyla otomatik olarak işaretleme

---

Belirli bir ek dosyaya göre e-postaları VBA koduyla otomatik olarak işaretleme

Belirli bir ek içeren e-postaları otomatik olarak işaretlemek için lütfen aşağıdaki VBA kodunu uygulayın:

1. Outlook'u başlatın ve "Microsoft Visual Basic for Applications" penceresini açmak için "ALT + F11" tuşlarına basın.

2. "Microsoft Visual Basic for Applications" penceresinde, "Project1 (VbaProject.OTM)" bölmesinde yer alan "ThisOutlookSession" öğesine çift tıklayarak yeni bir modül açın ve ardından aşağıdaki kodu bu boş modüle kopyalayıp yapıştırın.

VBA kodu: Belirli bir ek dosyaya göre e-postaları otomatik olarak işaretleme:

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

Not: Yukarıdaki kodda, dosya uzantısını ve ek dosya adını ihtiyacınız doğrultusunda özelleştirebilirsiniz.

3. Ardından kodu kaydedin ve etkinleşmesi için Outlook'u yeniden başlatın. Artık, ek dosya adlarında belirttiğiniz metni içeren e-postalar alındığında Outlook bu e-postaları takip için otomatik olarak işaretleyecektir; ekran görüntüsüne bakın: