¿Cómo marcar automáticamente los correos electrónicos basados ​​en archivos adjuntos específicos en Outlook?

Cuando reciba algunos correos electrónicos con archivos adjuntos importantes específicos, es posible que deba marcarlos para que pueda encontrarlos rápida y fácilmente para que fluyan hacia arriba. En este artículo, hablaré sobre una manera fácil de marcar automáticamente los correos electrónicos que tienen archivos adjuntos con nombres específicos.

Marque automáticamente los correos electrónicos basados ​​en archivos adjuntos específicos con código VBA

---

Marque automáticamente los correos electrónicos basados ​​en archivos adjuntos específicos con código VBA

Para marcar automáticamente los correos electrónicos que contienen el archivo adjunto específico, aplique el siguiente código VBA:

1. Inicie Outlook y luego mantenga presionado el ALT + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. En la Microsoft Visual Basic para aplicaciones ventana, haga doble clic Esta sesión de Outlook de Proyecto1 (VbaProject.OTM) panel para abrir un nuevo modo y luego copie y pegue el siguiente código en el módulo en blanco.

Código de VBA: marca automáticamente los correos electrónicos según un archivo adjunto específico:

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

Nota:: En el código anterior, puede cambiar la extensión del archivo y el nombre del archivo adjunto según sus necesidades.

3. Luego guarde el código y reinicie Outlook para que el código entre en vigencia, ahora, al recibir los correos electrónicos cuyos nombres de archivos adjuntos contienen el texto especificado, Outlook marcará automáticamente este correo electrónico para seguimiento, vea la captura de pantalla: