Hogyan lehet automatikusan megjelölni az e-maileket az Outlook külön csatolása alapján?

Ha e-maileket kap, amelyekhez fontos, fontos mellékletek tartoznak, előfordulhat, hogy meg kell jelölnie őket, hogy gyorsan és egyszerűen megtalálhassa őket a folyamatban. Ebben a cikkben egy egyszerű módról fogok beszélni, amellyel automatikusan megjelölik az e-maileket, amelyek a mellékleteket meghatározott nevekkel látják el.

Az e-maileket automatikusan megjelöli egy adott melléklet alapján, VBA kóddal

Az e-maileket automatikusan megjelöli egy adott melléklet alapján, VBA kóddal

Az adott mellékletet tartalmazó e-mailek automatikus megjelöléséhez kérjük, alkalmazza a következő VBA kódot:

1. Indítsa el az Outlook programot, majd tartsa lenyomva a ALT + F11 billentyűk megnyitásához Microsoft Visual Basic for Applications ablak.

2. Az Microsoft Visual Basic for Applications ablakban kattintson duplán ThisOutlookSession tól Project1 (VbaProject.OTM) ablaktáblán új mód megnyitásához, majd másolja és illessze be a következő kódot az üres modulba.

VBA-kód: Az e-maileket automatikusan megjelöli az adott melléklet alapján

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

Megjegyzések: A fenti kódban megváltoztathatja a fájlkiterjesztést és a melléklet fájlnevét az Ön igényeinek megfelelően.

3. Ezután mentse el a kódot, és indítsa újra az Outlook programot, hogy a kód életbe lépjen. Most, amikor megkapja az e-maileket, amelyek a mellékletek nevében tartalmazzák a megadott szöveget, az Outlook automatikusan megjelöli ezt az e-mailt nyomon követésre, lásd a képernyőképet: