Como alterar automaticamente a assinatura no Outlook consoante os destinatários?

Por predefinição, o Outlook inclui uma função integrada que permite aos utilizadores alterar automaticamente a assinatura ao enviar e-mails a partir de diferentes contas. Além disso, mostro-lhe aqui um método para mudar automaticamente a assinatura consoante os destinatários no campo Para do Outlook.

Alterar automaticamente a assinatura consoante os destinatários com código VBA

---

Alterar automaticamente a assinatura consoante os destinatários com código VBA

Siga os passos abaixo para aplicar assinaturas distintas a cada destinatário ao enviar e-mails no Outlook.

1. Em primeiro lugar, tem de desativar a funcionalidade de anexar automaticamente a assinatura no Outlook. Clique em Ficheiro > Opções para abrir a janela Opções do Outlook.

2. Na janela Opções do Outlook, selecione Correio no painel esquerdo e, em seguida, clique no botão Assinaturas na secção Compor mensagens. Veja a imagem:

3. Na caixa de diálogo Assinaturas e Papelaria, aceda à secção Escolher assinatura predefinida sob o separador Assinatura de E-mail, selecione uma conta de correio eletrónico na lista suspensa Conta de e-mail e, em seguida, escolha (nenhuma) nas listas suspensas Novas mensagens e Respostas/reencaminhamentos. Repita estes passos até que todas as contas estejam definidas como (nenhuma). Depois, clique no botão OK.

Nota: Pode também criar as assinaturas de que necessita nesta caixa de diálogo Assinaturas e Papelaria.

4. Clique no botão OK quando regressar à janela Opções do Outlook.

5. Prima as teclas Alt+F11 para abrir a janela Microsoft Visual Basic para Aplicações.

6. Na janela Microsoft Visual Basic para Aplicações, faça duplo clique em ThisOutlookSession no painel esquerdo para abrir a janela de código e copie o seguinte código VBA para essa janela. Veja a imagem:

Código VBA: Alterar automaticamente a assinatura consoante os destinatários no Outlook

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updated by ExtendOffice 2022/08/01
Dim xMailItem As MailItem
Dim xRecipients As Recipients
Dim xRecipient As Recipient
Dim xRcpAddress As String
Dim xSignatureFile, xSignaturePath As String
Dim xFSO As Scripting.FileSystemObject
Dim xDoc As Document
Dim xFindStr As String
On Error Resume Next
Set xFSO = New Scripting.FileSystemObject
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
Set xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
For Each xRecipient In xRecipients
    If xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
        xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
        xRcpAddress = xRecipient.AddressEntry.Address
    End If
    Select Case xRcpAddress
        Case "Email Address 1"
            xSignatureFile = xSignaturePath & "aaa.htm"
            Exit For
        Case "Email Address 2", "Email Address 3"
            xSignatureFile = xSignaturePath & "bbb.htm"
            Exit For
        Case "Email Address 4"
            xSignatureFile = xSignaturePath & "ccc.htm"
            Exit For
    End Select
Next
VBA.DoEvents
Set xDoc = xMailItem.GetInspector.WordEditor
xFindStr = "From: " & xMailItem.Recipients.Item(1).Name & " <" & xRcpAddress & ">"
If VBA.InStr(1, xMailItem.Body, xFindStr) <> 0 Then
    xDoc.Application.Selection.HomeKey Unit:=wdStory, Extend:=wdMove
    With xDoc.Application.Selection.Find
        .ClearFormatting
        .Text = xFindStr
        .Execute Forward:=True
    End With
    With xDoc.Application.Selection
        .MoveLeft wdCharacter, 2
        .InsertParagraphAfter
        .MoveDown Unit:=wdLine, Count:=1
    End With
Else
    With xDoc.Application.Selection
        .EndKey Unit:=wdStory, Extend:=wdMove
        .InsertParagraphAfter
        .MoveDown Unit:=wdLine, Count:=1
    End With
End If
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub

Notas:

• 1). No código VBA, substitua "Endereço de Email 1/2/3/4" pelo endereço de e-mail específico dos destinatários.
• 2). "aaa.htm", "bbb.htm« e »ccc.htm" são as assinaturas que enviará aos respetivos destinatários.
• 3). Neste caso, a assinatura "aaa« será enviada para »Endereço de Email 1«, a assinatura »bbb« será enviada para »Endereço de Email 2«, e os endereços »Endereço de Email 3" e "Endereço de Email 4« receberão o e-mail com a assinatura »ccc" incorporada. Por favor, ajuste-as conforme as suas necessidades.
• 4). Se um e-mail tiver vários destinatários, o código considera apenas o primeiro. Nesse caso, os restantes destinatários receberão o e-mail com a mesma assinatura atribuída ao primeiro destinatário.

7. Em seguida, clique em Ferramentas > Referências para aceder à caixa de diálogo Referências – Projeto. Na caixa de diálogo, marque as opções Microsoft Word Object Library e Microsoft Scripting Runtime e, depois, clique no botão OK. Veja a imagem:

8. Prima as teclas Alt + Q para fechar a janela Microsoft Visual Basic para Aplicações.

A partir de agora, após compor um e-mail e clicar no botão Enviar, a assinatura correspondente será inserida automaticamente no final do corpo da mensagem com base no endereço de e-mail do destinatário no campo Para.

---