Note: The other languages of the website are Google-translated. Back to English

Como alterar automaticamente a assinatura com base nos destinatários no Outlook?

Por padrão, o Outlook tem uma função integrada para que os usuários alterem automaticamente a assinatura ao enviar emails por meio de contas de email diferentes. Além disso, mostrarei aqui o método de alteração automática da assinatura com base em destinatários diferentes no campo Para do Outlook.

Altere a assinatura com base nos destinatários automaticamente com o código VBA


Altere a assinatura com base nos destinatários automaticamente com o código VBA

Siga as etapas abaixo para aplicar assinaturas diferentes aos destinatários correspondentes ao enviar e-mails no Outlook.

1. Em primeiro lugar, você precisa desativar o recurso de assinatura anexada automaticamente no Outlook. Por favor clique Envie o > Opções para abrir o Opções do Outlook janela.

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

3. No Assinaturas e papelaria caixa de diálogo, vá para o Escolha a assinatura padrão seção sob o Assinatura de e-mail guia, selecione uma conta de e-mail no Conta de e-mail lista suspensa e escolha (Nenhum) de Novas mensagens e Respostas / encaminhamentos listas suspensas. Repita essas etapas até que todas as contas de e-mail estejam definidas para (Nenhum). Em seguida, clique no botão OK botão.

Nota: Você também pode criar suas assinaturas necessárias neste Assinaturas e papelaria caixa de diálogo.

4. Clique na OK botão quando ele retorna o Opções do Outlook janela.

5. aperte o outro + F11 chaves para abrir o Microsoft Visual Basic para Aplicações janela.

6. No Microsoft Visual Basic para Aplicações janela, clique duplo Esta sessão do Outlook no painel esquerdo para abrir a janela Código e a cópia abaixo do código VBA na janela. Veja a imagem:

Código VBA: altera automaticamente a assinatura com base nos destinatários do 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 o “Endereço de Email 1/2/3/4”Com determinados endereços de e-mail dos destinatários.
  • 2). "aaa.htm""bbb.htm"E"ccc.htm" são as assinaturas especificadas que você enviará aos destinatários correspondentes.
  • 3). Neste caso, assinatura “aaa”Será enviado para“Endereço de Email 1”, Assinatura“bbb”Será enviado para“Endereço de Email 2"E"Endereço de Email 3"e “Endereço de Email 4”Receberá o e-mail com a assinatura“ccc”. Altere-os de acordo com suas necessidades.
  • 4). Se houver vários destinatários em um email, o código levará em consideração apenas o primeiro destinatário. Nesse caso, outros destinatários receberão os e-mails com a mesma assinatura do primeiro destinatário.

7. Então clique Ferramentas > Referências para ir para o Referências-Projeto caixa de diálogo. Na caixa de diálogo, verifique os Biblioteca de objetos do Microsoft Word e o Tempo de execução de scripts da Microsoft opções e clique em OK botão, veja a captura de tela:

8. aperte o outro + Q chaves para fechar o Microsoft Visual Basic para Aplicações janela.

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


Insira automaticamente a data atual como assinatura ao enviar e-mail no Outlook:

Se você deseja inserir um carimbo de data / hora como assinatura no corpo do e-mail ao criar / responder / encaminhar um novo e-mail no Outlook, você pode ativar o Adicionar assinatura de data ao criar um novo, responder e encaminhar e-mail opção de Kutools para Outlook para alcançá-lo. Veja a imagem:
Baixe e experimente agora (trilha gratuita de 60 dias)


Kutools for Outlook - traz 100 recursos avançados para o Outlook e torna o trabalho muito mais fácil!

  • Auto CC / BCC por regras ao enviar e-mail; Avanço automático Vários emails por encomenda; Resposta automatica sem servidor Exchange e mais recursos automáticos ...
  • Aviso BCC - mostrar mensagem quando você tentar responder a todos se o seu endereço de e-mail estiver na lista BCC; Lembrar quando houver anexos ausentes, e mais recursos de lembrete ...
  • Responder (todos) com todos os anexos na conversa de correio; Responder muitos e-mails em segundos; Adicionar saudação automaticamente quando responder; Adicionar data ao assunto ...
  • Ferramentas de anexo: gerenciar todos os anexos em todos os e-mails, Desanexação Automática, Comprimir tudo, Renomear tudo, Salvar tudo ... Relatório rápido, Contar e-mails selecionados...
  • Lixo eletrônico poderoso por costume; Remover e-mails e contatos duplicados... Permite que você faça de maneira mais inteligente, rápida e melhor no Outlook.
tiro kutools aba kutools do outlook 1180x121
tiro kutools outlook kutools mais guia 1180x121
 
Comentários (39)
Ainda não há classificações. Seja o primeiro a avaliar!
Este comentário foi feito pelo moderador no site
Como isso se comportaria se houvesse vários destinatários?
Este comentário foi feito pelo moderador no site
Olá Devansh,
Se houver vários destinatários em um email, o código funcionará apenas para o primeiro. E todos os destinatários receberão o e-mail com a mesma assinatura especificada para aquela pessoa.
Se você quiser incluir assinaturas diferentes quando houver vários destinatários, o email deve ser enviado separadamente para destinatários diferentes. E isso vai precisar de outro código para conseguir.
Este comentário foi feito pelo moderador no site
Olá! Script muito legal, mas há um problema ao enviar para endereços excahnge, o xRcpAddress retorna o nome do X400 e não o endereço smtp, isso impossibilita a seleção com base no domínio. Existe uma solução para isso?


Apenas para melhorar, alterei a instrução case para se estiver usando a função inStr para discernir e-mails em massa

If InStr(xRcpAddress, "@example") Então
xSignatureFile = xSignaturePath & "aaa.htm"
Se acabar
Este comentário foi feito pelo moderador no site
Adicionei este script inteligente ao Outlook 2013 e ele identifica e seleciona corretamente as diferentes assinaturas de email que uso.

Eu tenho um problema com um dos gráficos que faz parte de uma assinatura. Em vez do gráfico ser mostrado a pasta "Itens Enviados" (e destinatário) mostra o e-mail com a captura de tela anexada e tentar baixar a imagem não funciona.

Se eu desabilitar o script e assinar manualmente, o e-mail de saída estará correto e o destinatário receberá o que pretendo. Ainda mais interessante é que, com outra assinatura mais simples, onde o gráfico é apenas uma linha reta, isso é incluído, embora o gráfico seja ligeiramente alterado.

O gráfico é um arquivo PNG de 80 KB 5904 x 1024 pixels com uma profundidade de bits de 32 e tentei tamanhos menores até 10 KB 369 x 64 pixels, o que não ajudou. Minha versão do Outlook é 15.0.5189.1000 32Bit Professional Plus 2013 em uma plataforma Windows 10 Pro.

Gostaria de saber se você pode sugerir uma solução para isso, por favor.
Este comentário foi feito pelo moderador no site
Prezada Amanda,
Atualizamos o código. Obrigado por me lembrar do erro.
Este comentário foi feito pelo moderador no site
Script muito bom, mas os arquivos de imagem na minha assinatura não são entregues corretamente. Você pode corrigir esse problema?
Este comentário foi feito pelo moderador no site
Olá Vysakh,
O código foi atualizado e o problema das imagens foi corrigido agora. Desculpe pela inconveniência.
Este comentário foi feito pelo moderador no site
Olá Cristal,

o que você mudou para corrigir o problema das imagens? Estou usando seu código mais recente e tenho o mesmo problema que Amanda.
obrigado
Este comentário foi feito pelo moderador no site
Oi,
Desculpe-me pelo erro. O VBA foi atualizado novamente e o problema das imagens está totalmente corrigido agora.
Este comentário foi feito pelo moderador no site
Além do código, o funcionamento do passo 7 também mudou. Por favor, siga as instruções passo a passo para baixá-lo.
Este comentário foi feito pelo moderador no site
Olá, gostaria de aplicar isso para diferenciar assinaturas ao enviar e-mails internos e externos. Portanto, em vez de reconhecer endereços de e-mail específicos, eu precisaria apenas diferenciar pelo endereço de e-mail do destinatário contendo o nome da minha empresa dentro dele ou não. Você poderia me informar como seria o código para este caso específico?


(Por exemplo, se eu quisesse assinar com a assinatura "internal.htm" quando o email do destinatário contiver a string "microsoft" e a assinatura "external.htm" se não contiver a string "microsoft". Neste caso endereços como ' jane@microsoft.com', 'tom@microsoft.support.com' e 'recruiting@microsoft.europe.com' seriam considerados como destinatários internos de um funcionário da Microsoft).

Obrigado!!
Este comentário foi feito pelo moderador no site
Olá pauli,
Por favor, tente o código abaixo. Antes de aplicar o código, acesse o Referências diálogo para verificar o Biblioteca de objetos do Microsoft Word caixa (como a imagem anexada mostrada).

Private Sub Application_ItemSend (ByVal Item As Object, Cancel As Boolean)

'Atualizado por ExtendOffice 2020/6/12

Dim xMailItem As MailItem

Escurecer xRecipients como destinatários

Dim xRecipient como destinatário

Dim xRcpAddress como String

Dim xSignatureFile, xSignaturePath como String

Dim xFSO como Scripting.FileSystemObject

Dim xDoc como documento

On Error Resume Next

Definir xFSO = Novo Scripting.FileSystemObject

If Item.Class <> olMail Then Exit Sub

Definir xMailItem = Item

Definir xRecipients = xMailItem.Recipients

xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"

Para cada xRecipient em xRecipients

Se xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Então

xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress

Outro

xRcpAddress = xRecipient.AddressEntry.Address

Se acabar

If VBA.InStr(VBA.LCase(xRcpAddress), "@microsoft") > 0 Then 'Insira a string entre aspas duplas. Se o endereço de e-mail do destinatário contiver esta string, a assinatura abaixo "internal.htm" será atribuída ao e-mail. Caso contrário, atribua a assinatura "external.htm".

xSignatureFile = xSignaturePath & "interno.htm"

Sair para

Outro

xSignatureFile = xSignaturePath & "externo.htm"

Se acabar

Seguinte

VBA.DoEvents

Definir xDoc = xMailItem.GetInspector.WordEditor

xDoc.Application.Selection.EndKey

xDoc.Application.Selection.InsertParagraphAfter

xDoc.Application.Selection.MoveDown Unidade:=wdLine, Contagem:=1

xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False

End Sub
Este comentário foi feito pelo moderador no site
Olá Cristal, tenho uma dúvida. Quando estou enviando e-mails para destinatários externos e internos, como posso diferenciá-lo escolhendo sempre a assinatura externa? Obrigado
Este comentário foi feito pelo moderador no site
Você pode ter encontrado a solução para si mesmo agora ou abandonado este tópico há muito tempo, mas sinto o desejo de terminar isso agora. A resposta simples para esta pergunta:
Edite a If-Else-Clause (que diferencia as duas assinaturas) para o seguinte:
If VBA.InStr(VBA.LCase(xRcpAddress), "@microsoft") = 0 Then 'Digite a string entre aspas duplas. Se o endereço de e-mail do destinatário contiver essa string, a assinatura abaixo "internal.htm" será atribuída ao e-mail. Caso contrário, atribua a assinatura "external.htm".
xSignatureFile = xSignaturePath & "external.htm"
Sair para
Outro
xSignatureFile = xSignaturePath & "internal.htm"
Se acabar

O que acontece agora:
Se o endereço do destinatário de uma lista de endereços de destinatários NÃO contiver a string fornecida, use a assinatura externa e pare de procurar outros destinatários. Caso contrário, use a assinatura interna e procure o próximo endereço do destinatário.
Este comentário foi feito pelo moderador no site
Eu tenho algum comportamento estranho com e-mails do Outlook gerados pelo VBA. A assinatura é adicionada ao e-mail como pretendido, mas não posicionada na parte inferior do e-mail, mas sim no meio (parece no primeiro espaço vazio). Alguma idéia de por que e como superá-lo?
Este comentário foi feito pelo moderador no site
Tim eu tenho o mesmo problema. Onde quer que o usuário clique por último é onde a imagem é inserida. Alguém tem uma maneira de forçar a imagem logo acima da assinatura?
Este comentário foi feito pelo moderador no site
Olá Cristal,
Estou interessado no código VBA que você escreveu para "pauli" abaixo, mas quando o executo, o seguinte erro é gerado (e a linha de código "XDoc as Document" é destacada):
"Erro de compilação: tipo definido pelo usuário não definido"
Como posso resolver este problema por favor?

Obrigado, Tim
Este comentário foi feito pelo moderador no site
Olá Cristal,

Estou interessado no código VBA que você escreveu para "pauli" abaixo, mas quando o executo, o seguinte erro é gerado (e a linha de código "XDoc as Document" é destacada):

"Erro de compilação: tipo definido pelo usuário não definido"

Como posso resolver este problema por favor?

Obrigado!
Este comentário foi feito pelo moderador no site
Oi Tim,Antes de aplicar o código, vá para a caixa de diálogo References para verificar o Biblioteca de objetos do Microsoft Word caixa (como a imagem anexada mostrada).
Este comentário foi feito pelo moderador no site
Ótimo roteiro. Obrigado. Qualquer maneira de inserir a assinatura antes de clicar em enviar para visualização. Eu sei que posso atrasar o envio e ver na caixa de saída. Atualmente, ele não aparece até que eu clique em enviar. Caso contrário, existe algum software que atribuirá automaticamente uma assinatura com base no Contato. Temos usado um programa por muitos anos que funcionou muito bem, mas não funciona em novas versões do Outlook.
Este comentário foi feito pelo moderador no site
Este script é ótimo e funcional para o que eu estava procurando. É possível fazer com que o código diferencie se a mensagem é nova ou uma resposta, bem como o domínio do e-mail? Por exemplo, para selecionar ainda mais uma assinatura separada para respostas a destinatários externos versus uma nova mensagem para destinatários externos?
Obrigado por compartilhar.
Este comentário foi feito pelo moderador no site
Oi Seth,O código abaixo diferencia se a mensagem é nova ou uma resposta para inserir uma assinatura. Você precisa alterar manualmente o "Email"E"Endereço de email de resposta" e os nomes de assinatura correspondentes no código.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Atualizado por ExtendOffice 2020/12/24
Dim xMailItem As MailItem
Escurecer xRecipients como destinatários
Dim xRecipient como destinatário
Dim xRcpAddress como String
Dim xSignatureFile, xSignaturePath como String
Dim xFSO como Scripting.FileSystemObject
Dim xDoc como documento
On Error Resume Next
Definir xFSO = Novo Scripting.FileSystemObject
If Item.Class <> olMail Then Exit Sub
Definir xMailItem = Item
Definir xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
If InStr(xMailItem.Subject, "RE: ") <> 1 Then
Para cada xRecipient em xRecipients
Se xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Então
xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
Outro
xRcpAddress = xRecipient.AddressEntry.Address
Se acabar
Selecionar caso xRcpAddress
Caso "Endereço de Email 1"
xSignatureFile = xSignaturePath & "aaa.htm"
Sair para
Caso "Endereço de Email 2""Endereço de Email 3"
xSignatureFile = xSignaturePath & "bbb.htm"
Sair para
Caso "Endereço de Email 4"
xSignatureFile = xSignaturePath & "ccc.htm"
Sair para
End Select
Seguinte
Outro
Para cada xRecipient em xRecipients
Se xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Então
xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
Outro
xRcpAddress = xRecipient.AddressEntry.Address
Se acabar
Selecionar caso xRcpAddress
Caso "b"
xSignatureFile = xSignaturePath & "111.htm" '111.htm é o nome da assinatura que você inserirá quando responder ao "Endereço de e-mail de resposta 1"
Sair para
Caso "Endereço de e-mail de resposta 2""Endereço de e-mail de resposta 3"
xSignatureFile = xSignaturePath & "222.htm"
Sair para
Caso "Endereço de e-mail de resposta 4"
xSignatureFile = xSignaturePath & "333.htm"
Sair para
End Select
Seguinte
Se acabar
VBA.DoEvents
Definir xDoc = xMailItem.GetInspector.WordEditor
xDoc.Application.Selection.EndKey
xDoc.Application.Selection.InsertParagraphAfter
xDoc.Application.Selection.MoveDown Unidade:=wdLine, Contagem:=1
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub
Este comentário foi feito pelo moderador no site
Este código funcionou para mim até que reiniciei meu PC. Quando abro o alt+F11 novamente, todo o código ainda está no mesmo lugar, mas quando envio um e-mail, ele apenas o envia sem assinatura e sem emitir nenhum tipo de mensagem de aviso.
Este comentário foi feito pelo moderador no site
Oi Ivan,O problema é causado pelo Excel desabilitando a opção Macro. Você precisa entrar na janela Opções do Outlook clicando em Envie o > Opções. No Opções do Outlook janela, clique em trust Center no painel esquerdo e clique em Configurações da Central de confiança botão. No trust Center janela, clique em Configurações de macro no painel esquerdo e, em seguida, selecione o Habilitar todas as macros botão de rádio e verifique o Aplicar configurações de segurança de macro aos suplementos instalados caixa. Veja a captura de tela anexada abaixo.
Este comentário foi feito pelo moderador no site
Olá Cristal,
Tenho uma dúvida sobre o código fonte abaixo.
Gostaria de enviar uma assinatura interna apenas para determinados destinatários de e-mail (30), assim que outro endereço de e-mail for adicionado, a assinatura externa deverá ser usada.
Você pode me ajudar com meu pedido?
Muito obrigado antecipadamente.
Este comentário foi feito pelo moderador no site
Eu tenho várias contas de e-mail configuradas no Outlook e tenho seu script configurado para enviar assinaturas diferentes para os e-mails internos e externos.

Como posso modificar o script para que ele só envie essas assinaturas se eu estiver enviando de jweaver@andrewslogistics.com?

Em outras palavras, não quero enviar essas assinaturas quando estou enviando de um endereço de e-mail diferente de jweaver@andrewslogistics.com.

Obrigado,
Este comentário foi feito pelo moderador no site
Olá Jeff Weaver.
O código VBA a seguir foi modificado para inserir essas assinaturas ao enviar emails apenas de uma conta de email especificada. Por favor, tente. espero poder ajudar.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updated by ExtendOffice 2022/06/10
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
On Error Resume Next
Set xFSO = New Scripting.FileSystemObject
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
If xMailItem.SendUsingAccount.SmtpAddress <> "jweaver@andrewslogistics.com" Then Exit Sub 'The email account you send emails from
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
xDoc.Application.Selection.EndKey
xDoc.Application.Selection.InsertParagraphAfter
xDoc.Application.Selection.MoveDown Unit:=wdLine, Count:=1
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub
Este comentário foi feito pelo moderador no site
Oi Crystal - Eu também tenho o mesmo problema que Tim (#33997) e Greg (#34358) mencionados acima, mas não vejo uma solução. A assinatura aparece no meu e-mail no último lugar em que clico antes de clicar em 'enviar', muitas vezes aparecendo no meio do e-mail. Alguma ajuda/soluções?

Obrigado!

Eric
Este comentário foi feito pelo moderador no site
Olá Eric Anderson,
Obrigado pelo seu feedback. O código já foi atualizado e o problema foi resolvido. Por favor, tente.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updated by ExtendOffice 2022/6/24
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
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
    Debug.Print xRcpAddress
    Select Case xRcpAddress
        Case "464653358@qq.com"
            xSignatureFile = xSignaturePath & "aaa.htm"
            Exit For
        Case "siluvia@extendoffice.com", "happy.xuebi@163.com"
            xSignatureFile = xSignaturePath & "bbb.htm"
            Exit For
        Case "happysiluvia@gmail.com"
            xSignatureFile = xSignaturePath & "ccc.htm"
            Exit For
    End Select
Next
VBA.DoEvents
Set xDoc = xMailItem.GetInspector.WordEditor
xDoc.Application.Selection.EndKey Unit:=wdStory, Extend:=wdMove
xDoc.Application.Selection.InsertParagraphAfter
xDoc.Application.Selection.MoveDown Unit:=wdLine, Count:=1
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub
Este comentário foi feito pelo moderador no site
Bom Dia,

Quand je réponds to des mails, la signature automatic s'insère tout en bas, mais j'aimerais qu'elle s'insère en bas de mon message à moi.

Você tem uma solução?

Lélian
Este comentário foi feito pelo moderador no site
Olá LÉLIAN ALEMPS.
O código VBA foi atualizado. Obrigado pelo seu feedback. Por favor, tente.

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
Este comentário foi feito pelo moderador no site
Olá Cristal,

Assim como outros neste tópico, gostaria que minha assinatura fosse padronizada para uma assinatura externa se houver algum endereço de e-mail não interno na linha para ou cc e mude para uma assinatura interna quando for apenas endereços de e-mail internos. Para fazer isso, combinei seu código mais atualizado (resposta a Lelian) com a resposta de Random_Guest a Daniela (padrão para a assinatura externa). O resultado é que quando estou respondendo apenas a endereços de e-mail internos, a assinatura funciona perfeitamente; no entanto, quando minha assinatura externa é puxada, ela a coloca na parte inferior da cadeia de e-mail, não no final do e-mail que estou enviando. Você pode por favor aconselhar como corrigir? Incluí o código abaixo:

Private Sub Application_ItemSend (ByVal Item As Object, Cancel As Boolean)
'Atualizado por ExtendOffice 2022/08/01
Dim xMailItem As MailItem
Escurecer xRecipients como destinatários
Dim xRecipient como destinatário
Dim xRcpAddress como String
Dim xSignatureFile, xSignaturePath como String
Dim xFSO como Scripting.FileSystemObject
Dim xDoc como documento
Dim xFindStr As String
On Error Resume Next
Definir xFSO = Novo Scripting.FileSystemObject
If Item.Class <> olMail Then Exit Sub
Definir xMailItem = Item
Definir xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
Para cada xRecipient em xRecipients
Se xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Então
xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
Outro
xRcpAddress = xRecipient.AddressEntry.Address
Se acabar
If VBA.InStr(VBA.LCase(xRcpAddress), "@mycompany'sname") = 0 Then 'Digite a string entre aspas duplas. Se o endereço de e-mail do destinatário contiver essa string, a assinatura abaixo "internal.htm" será atribuída ao e-mail. Caso contrário, atribua a assinatura "external.htm".
xSignatureFile = xSignaturePath & "External.htm"
Sair para
Outro
xSignatureFile = xSignaturePath & "Internal.htm"
Se acabar
Seguinte
VBA.DoEvents
Definir 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
Com xDoc.Application.Selection.Find
.Limpar formatação
.Texto = xFindStr
.Execute Forward:=True
Terminar com
Com xDoc.Application.Selection
.MoveLeft wdCharacter, 2
.InsertParagraphAfter
Unidade .MoveDown:=wdLine, Contagem:=1
Terminar com
Outro
Com xDoc.Application.Selection
.EndKey Unit:=wdStory, Extend:=wdMove
.InsertParagraphAfter
Unidade .MoveDown:=wdLine, Contagem:=1
Terminar com
Se acabar
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub
Este comentário foi feito pelo moderador no site
Oi Josh,
Este problema é um pouco complicado. Preciso de tempo para encontrar uma solução. Só não é capaz de lidar com isso agora. Desculpe por isso.
Este comentário foi feito pelo moderador no site
Sem problemas - obrigado por dar uma olhada!
Este comentário foi feito pelo moderador no site
Olá Cristal,

Espero que você esteja bem.

Você pode informar se é possível adicionar uma assinatura diferente com base no campo de assunto com palavras específicas.

Muito obrigado
Matt
Este comentário foi feito pelo moderador no site
Olá Matt Read,
Obrigado pelo seu comentário. Ainda não estou conseguindo resolver este problema.
Este comentário foi feito pelo moderador no site
Ok obrigado por tomar o tempo
Este comentário foi feito pelo moderador no site
Oi! Eu implementei o código na maior parte dele funciona como pretendido. No entanto, de vez em quando ele insere a assinatura no meio de uma mensagem. aconteceu pela primeira vez quando eu anexei na tabela no corpo. a assinatura foi inserida na tabela. Além disso, aconteceu que ele corta parte do texto de tal forma que duas ou três linhas de texto ficam no final do e-mail (após a assinatura). Isso não acontece o tempo todo, mas espero que você possa ajudar a resolvê-lo para que se torne mais confiável.
Este comentário foi feito pelo moderador no site
Olá Mikkel Lundsgaard,
O código funciona bem no meu caso. Qual versão do Outlook você está usando?
Não há comentários postados aqui ainda
Deixe o seu comentário
Postando como convidado
×
Avalie esta postagem:
0   Personagens
Locais sugeridos