Como sinalizar automaticamente e-mails com base num anexo específico no Outlook?

Ao receber alguns e-mails com um anexo importante específico, poderá precisar de os sinalizar, de modo a poder encontrá-los rápida e facilmente para acompanhamento. Neste artigo, explico uma forma simples de sinalizar automaticamente os e-mails cujos anexos tenham nomes específicos.

Sinalizar automaticamente e-mails com base num anexo específico com código VBA

---

Sinalizar automaticamente e-mails com base num anexo específico com código VBA

Para sinalizar automaticamente os e-mails que contenham um anexo específico, aplique o seguinte código VBA:

1. Inicie o Outlook e, em seguida, prima as teclas «ALT + F11» para abrir a janela do Microsoft Visual Basic for Applications.

2. Na janela «Microsoft Visual Basic for Applications», clique duas vezes em «ThisOutlookSession», no painel "Project1 (VbaProject.OTM)", para abrir um novo módulo e, em seguida, copie e cole o código seguinte no módulo em branco.

Código VBA: Sinalizar automaticamente e-mails com base num anexo 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"
                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

Nota: No código acima, pode alterar a extensão do ficheiro e o nome do anexo conforme as suas necessidades.

3. Em seguida, guarde o código e reinicie o Outlook para que as alterações entrem em vigor. A partir de agora, sempre que receber e-mails com anexos cujos nomes contenham o texto especificado, o Outlook irá sinalizá-los automaticamente para acompanhamento, conforme ilustrado na imagem: