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

Comment changer automatiquement la signature en fonction des destinataires dans Outlook?

Par défaut, Outlook dispose d'une fonction intégrée permettant aux utilisateurs de modifier automatiquement la signature lors de l'envoi d'e-mails via différents comptes de messagerie. Mais au-delà de cela, je vais vous montrer ici la méthode de modification automatique de la signature en fonction de différents destinataires dans le champ À dans Outlook.

Changer la signature en fonction des destinataires automatiquement avec le code VBA


Changer la signature en fonction des destinataires automatiquement avec le code VBA

Veuillez suivre les étapes ci-dessous pour appliquer différentes signatures aux destinataires correspondants lors de l'envoi d'e-mails dans Outlook.

1. Tout d'abord, vous devez désactiver la fonctionnalité de signature automatique dans Outlook. Cliquez s'il vous plait Déposez le > Options ouvrir le Options d'Outlook fenêtre.

2. dans le Options d'Outlook fenêtre, sélectionnez Courrier dans le volet gauche, puis cliquez sur le Signatures bouton dans le Composer des messages section. Voir la capture d'écran:

3. dans le Signatures et papeterie boîte de dialogue, accédez à Choisissez la signature par défaut section sous la Signature par e-mail , sélectionnez un compte de messagerie dans le Compte email liste déroulante, puis choisissez (Aucun) du Nouveaux messages et Réponses / transferts listes déroulantes. Répétez ces étapes jusqu'à ce que tous les comptes de messagerie soient définis sur (Aucun). Puis cliquez sur le OK .

Notes: Vous pouvez également créer les signatures nécessaires dans ce Signatures et papeterie boite de dialogue.

4. Cliquez sur l' OK bouton quand il renvoie le Options d'Outlook fenêtre.

5. appuie sur le autre + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

6. dans le Microsoft Visual Basic pour applications fenêtre, double-cliquez Cette session Outlook dans le volet gauche pour ouvrir la fenêtre Code, et la copie sous le code VBA dans la fenêtre. Voir la capture d'écran:

Code VBA: modifier automatiquement la signature en fonction des destinataires dans 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

Notes:

  • 1). Dans le code VBA, veuillez remplacer le "Adresse e-mail 1/2/3/4”Avec certaines adresses e-mail des destinataires.
  • 2). "aaa.htm""bbb.htm" et "ccc.htm" sont les signatures spécifiées que vous enverrez aux destinataires correspondants.
  • 3). Dans ce cas, la signature "aaa"Sera envoyé à"Adresse e-mail 1", Signature "bbb"Sera envoyé à"Adresse e-mail 2" et "Adresse e-mail 3 », et "Adresse e-mail 4"Recevra l'e-mail avec signature"ccc». Veuillez les modifier en fonction de vos besoins.
  • 4). S'il y a plusieurs destinataires dans un e-mail, le code ne prend en compte que le premier destinataire. Dans ce cas, les autres destinataires recevront les e-mails avec la même signature que le premier destinataire.

7. Puis clique Outils > Références pour aller à la Références-Projet boite de dialogue. Dans la boîte de dialogue, veuillez vérifier les deux Bibliothèque d'objets Microsoft Word et le Exécution de scripts Microsoft options, puis cliquez sur OK bouton, voir capture d'écran:

8. appuie sur le autre + Q touches pour fermer le Microsoft Visual Basic pour applications fenêtre.

Désormais, après avoir rédigé un e-mail et appuyé sur le bouton Envoyer, la signature correspondante sera automatiquement insérée à la fin du corps de l'e-mail en fonction de l'adresse e-mail du destinataire dans le champ À.


Insérer automatiquement la date actuelle comme signature lors de l'envoi d'un e-mail dans Outlook:

Si vous souhaitez insérer un horodatage comme signature dans le corps de l'e-mail lors de la création / réponse / transfert d'un nouvel e-mail dans votre Outlook, vous pouvez activer le Ajouter une signature de date lors de la création, de la réponse et du transfert de courrier option de Kutools pour Outlook pour y parvenir. Voir la capture d'écran:
Téléchargez-le et essayez-le maintenant (parcours gratuit de 60 jours)


Kutools for Outlook - Apporte 100 fonctionnalités avancées à Outlook et simplifie grandement le travail!

  • CC / BCC automatique par des règles lors de l'envoi d'e-mails; Transfert automatique Emails multiples par coutume; Réponse automatique sans serveur d'échange, et plus de fonctionnalités automatiques ...
  • Avertissement BCC - afficher le message lorsque vous essayez de répondre à tous si votre adresse e-mail est dans la liste BCC; Rappeler en cas de pièces jointes manquantes, et plus de fonctionnalités de rappel ...
  • Répondre (à tous) avec toutes les pièces jointes dans la conversation par courrier électronique; Répondre à de nombreux e-mails en secondes; Ajouter un message d'accueil automatique quand répondre; Ajouter la date au sujet ...
  • Outils de pièces jointes: gérer toutes les pièces jointes dans tous les courriers, Détachement automatique, Compresser tout, Tout renommer, Tout enregistrer ... Rapport rapide, Compter les courriers sélectionnésplus
  • Courriels indésirables puissants par coutume; Supprimer les messages et contacts en doubleplus Vous permettre de faire plus intelligemment, plus rapidement et mieux dans Outlook.
tir kutools outlook onglet kutools 1180x121
tir kutools outlook kutools plus onglet 1180x121
 
Commentaires (39)
Pas encore de notes. Soyez le premier à évaluer!
Ce commentaire a été minimisé par le modérateur sur le site
Comment cela se comporterait-il s'il y avait plusieurs destinataires ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut Devansh,
S'il y a plusieurs destinataires dans un e-mail, le code ne fonctionne que pour le premier. Et tous les destinataires recevront l'e-mail avec la même signature que celle spécifiée pour cette personne.
Si vous souhaitez inclure différentes signatures lorsqu'il y a plusieurs destinataires, l'e-mail doit être envoyé séparément à différents destinataires. Et cela nécessitera un autre code pour y parvenir.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour! Très beau script, mais il y a un problème lors de l'envoi vers des adresses d'échange, le xRcpAddress renvoie le nom X400 et non l'adresse smtp, cela rend impossible la sélection en fonction du domaine. Existe-t-il une solution de contournement ?


Juste pour améliorer, j'ai changé la déclaration de cas en utilisant la fonction inStr pour discerner les mails en masse

Si InStr(xRcpAddress, "@example") Alors
xSignatureFile = xSignaturePath & "aaa.htm"
Si fin
Ce commentaire a été minimisé par le modérateur sur le site
J'ai ajouté ce script intelligent à Outlook 2013 et il identifie et sélectionne correctement les différentes signatures de courrier électronique que j'utilise.

J'ai un problème avec l'un des graphiques faisant partie d'une signature. Au lieu d'afficher le graphique, le dossier "Éléments envoyés" (et le destinataire) affiche l'e-mail avec la capture d'écran jointe et la tentative de téléchargement de l'image ne fonctionne pas.

Si je désactive le script et que je signe manuellement, l'e-mail sortant est correct et le destinataire reçoit ce que j'ai l'intention de faire. Encore plus intéressant, c'est qu'avec une autre signature plus simple où le graphique est juste une ligne droite, cela est inclus bien que le graphique soit légèrement modifié.

Le graphique est un fichier PNG 80 Ko 5904 x 1024 pixels avec une profondeur de 32 bits et j'ai essayé des tailles plus petites jusqu'à 10 Ko 369 x 64 pixels, ce qui n'a pas aidé. Ma version d'Outlook est 15.0.5189.1000 32Bit Professional Plus 2013 sur une plate-forme Windows 10 Pro.

Je me demande si vous pouvez suggérer une solution pour cela s'il vous plaît.
Ce commentaire a été minimisé par le modérateur sur le site
Chère Amanda,
Nous avons mis à jour le code. Merci de m'avoir rappelé l'erreur.
Ce commentaire a été minimisé par le modérateur sur le site
Très beau script mais les fichiers image de ma signature ne sont pas livrés correctement. Pouvez-vous résoudre ce problème ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut Vysakh,
Le code a été mis à jour et le problème des images est maintenant résolu. Désolé pour le dérangement.
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal,

qu'avez-vous changé pour résoudre le problème des images ? J'utilise votre dernier code et j'ai le même problème qu'Amanda.
Merci
Ce commentaire a été minimisé par le modérateur sur le site
Hi,
Désolé pour l'erreur. Le VBA a été mis à jour à nouveau et le problème des images est totalement résolu maintenant.
Ce commentaire a été minimisé par le modérateur sur le site
Outre le code, le fonctionnement de l'étape 7 a également changé. Veuillez suivre les instructions étape par étape pour le descendre.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, je voudrais appliquer ceci pour différencier les signatures lors de l'envoi d'e-mails internes et externes. Par conséquent, au lieu de reconnaître des adresses e-mail spécifiques, je devrais simplement différencier l'adresse e-mail du destinataire contenant ou non le nom de mon entreprise. Pourriez-vous me faire savoir comment le code serait pour ce cas spécifique?


(Par exemple, si je voulais signer avec la signature "internal.htm" lorsque l'e-mail du destinataire contient la chaîne "microsoft" et la signature "external.htm" s'il ne contient pas la chaîne "microsoft". Dans ce cas, des adresses comme ' jane@microsoft.com', 'tom@microsoft.support.com' et 'recruiting@microsoft.europe.com' seraient tous considérés comme les destinataires internes d'un employé de Microsoft).

Merci!!
Ce commentaire a été minimisé par le modérateur sur le site
Salut pauli,
Veuillez essayer le code ci-dessous. Avant d'appliquer le code, veuillez vous rendre sur le Références boîte de dialogue pour vérifier Bibliothèque d'objets Microsoft Word boîte (comme l'image ci-jointe montrée).

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

'Mis à jour par ExtendOffice 2020/6/12

Dim xMailItem As MailItem

Dim xRecipients en tant que destinataires

Dim xRecipient en tant que destinataire

Dim xRcpAddress As String

Dim xSignatureFile, xSignaturePath As String

Dim xFSO en tant que Scripting.FileSystemObject

Estomper xDoc en tant que document

On Error Resume Next

Définir xFSO = Nouveau Scripting.FileSystemObject

Si Item.Class <> olMail Alors Quittez Sub

Définir xMailItem = Article

Définir xRecipients = xMailItem.Recipients

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

Pour chaque xRecipient dans xRecipients

Si xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Alors

xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress

autre

xRcpAddress = xRecipient.AddressEntry.Address

Si fin

Si VBA.InStr(VBA.LCase(xRcpAddress), "@microsoft") > 0 Puis 'Entrez la chaîne entre guillemets doubles. Si l'adresse e-mail du destinataire contient cette chaîne, la signature ci-dessous "interne.htm" sera attribuée à l'e-mail. Sinon, attribuez la signature "externe.htm".

xFichierSignature = xCheminSignature & "interne.htm"

Sortie pour

autre

xFichierSignature = xCheminSignature & "externe.htm"

Si fin

Suivant

VBA.DoEventsVBA.DoEvents

Définir xDoc = xMailItem.GetInspector.WordEditor

xDoc.Application.Selection.EndKey

xDoc.Application.Selection.InsertParagraphAfter

xDoc.Application.Selection.MoveDown Unité :=wdLine, Nombre :=1

xDoc.Application.Selection.InsertFile NomFichier :=xSignatureFile, Lien :=Faux, Pièce jointe :=Faux

End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Crystal, j'ai une question. Lorsque j'envoie des e-mails à la fois à des destinataires externes et internes, comment puis-je le différencier en choisissant toujours la signature externe ? Merci
Ce commentaire a été minimisé par le modérateur sur le site
Vous avez peut-être déjà trouvé la solution par vous-même ou abandonné ce fil il y a longtemps, mais je ressens le besoin de le terminer maintenant. La réponse simple à cette question :
Modifiez la clause If-Else-Clause (qui différencie les deux signatures) comme suit :
Si VBA.InStr(VBA.LCase(xRcpAddress), "@microsoft") = 0 Then 'Entrez la chaîne entre guillemets doubles. Si l'adresse e-mail du destinataire contient cette chaîne, la signature ci-dessous "internal.htm" sera attribuée à l'e-mail. Sinon, attribuez la signature "external.htm".
xSignatureFile = xSignaturePath & "external.htm"
Sortie pour
autre
xSignatureFile = xSignaturePath & "interne.htm"
Si fin

Que se passe-t-il maintenant :
Si l'adresse du destinataire d'une liste d'adresses de destinataires ne contient PAS la chaîne donnée, utilisez la signature externe et arrêtez de rechercher d'autres destinataires. Sinon, utilisez la signature interne et recherchez la prochaine adresse du destinataire.
Ce commentaire a été minimisé par le modérateur sur le site
J'ai un comportement étrange avec les e-mails Outlook générés par VBA. La signature est ajoutée au mail comme prévu, mais pas positionnée en bas du mail mais plutôt au milieu (ressemble au premier espace vide). Une idée pourquoi et comment le surmonter?
Ce commentaire a été minimisé par le modérateur sur le site
Tim j'ai le même problème. L'image est insérée là où l'utilisateur clique en dernier. Quelqu'un a-t-il un moyen de forcer l'image juste au-dessus de la signature?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Cristal,
Je suis intéressé par le code VBA que vous avez écrit pour "pauli" ci-dessous, mais lorsque je l'exécute, l'erreur suivante est générée (et la ligne de code "XDoc as Document" est mise en surbrillance):
"Erreur de compilation : type défini par l'utilisateur non défini"
Comment puis-je résoudre ce problème s'il vous plaît?

Merci Tim
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Cristal,

Je suis intéressé par le code VBA que vous avez écrit pour "pauli" ci-dessous, mais lorsque je l'exécute, l'erreur suivante est générée (et la ligne de code "XDoc as Document" est mise en surbrillance):

"Erreur de compilation : type défini par l'utilisateur non défini"

Comment puis-je résoudre ce problème s'il vous plaît?

Merci !
Ce commentaire a été minimisé par le modérateur sur le site
Salut Tim, avant d'appliquer le code, veuillez accéder à la boîte de dialogue Références pour vérifier le Bibliothèque d'objets Microsoft Word boîte (comme l'image ci-jointe montrée).
Ce commentaire a été minimisé par le modérateur sur le site
Grand scénario. Merci. N'importe quel moyen d'insérer la signature avant d'appuyer sur envoyer pour prévisualiser. Je sais que je peux retarder l'envoi et le regarder dans la boîte d'envoi. Actuellement, il n'apparaît pas tant que je n'ai pas cliqué sur envoyer. Sinon, existe-t-il un logiciel qui attribuera automatiquement une signature basée sur Contact. Nous utilisons depuis de nombreuses années un programme qui fonctionnait très bien, mais il ne fonctionne pas dans les nouvelles versions d'Outlook.
Ce commentaire a été minimisé par le modérateur sur le site
Ce script est génial et fonctionnel pour ce que je cherchais. Est-il possible de différencier le code si le message est nouveau ou une réponse ainsi que le domaine de messagerie ? Par exemple, pour sélectionner davantage une signature distincte pour les réponses aux destinataires externes par rapport à un nouveau message aux destinataires externes ?
Merci pour le partage.
Ce commentaire a été minimisé par le modérateur sur le site
Salut Seth, Le code ci-dessous différencie si le message est nouveau ou une réponse pour insérer une signature. Vous devez modifier manuellement le "Adresse courriel" et "Adresse e-mail de réponse" et les noms de signature correspondants dans le code.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Mis à jour par ExtendOffice 2020/12/24
Dim xMailItem As MailItem
Dim xRecipients en tant que destinataires
Dim xRecipient en tant que destinataire
Dim xRcpAddress As String
Dim xSignatureFile, xSignaturePath As String
Dim xFSO en tant que Scripting.FileSystemObject
Estomper xDoc en tant que document
On Error Resume Next
Définir xFSO = Nouveau Scripting.FileSystemObject
Si Item.Class <> olMail Alors Quittez Sub
Définir xMailItem = Article
Définir xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
Si InStr(xMailItem.Subject, "RE : ") <> 1 Alors
Pour chaque xRecipient dans xRecipients
Si xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Alors
xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
autre
xRcpAddress = xRecipient.AddressEntry.Address
Si fin
Sélectionner le cas xRcpAddress
Cas "Adresse e-mail 1"
xFichierSignature = xCheminSignature & "aaa.htm"
Sortie pour
Cas "Adresse e-mail 2""Adresse e-mail 3"
xFichierSignature = xCheminSignature & "bbb.htm"
Sortie pour
Cas "Adresse e-mail 4"
xFichierSignature = xCheminSignature & "ccc.htm"
Sortie pour
End Select
Suivant
autre
Pour chaque xRecipient dans xRecipients
Si xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Alors
xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
autre
xRcpAddress = xRecipient.AddressEntry.Address
Si fin
Sélectionner le cas xRcpAddress
Cas "b"
xFichierSignature = xCheminSignature & "111.htm" '111.htm est le nom de la signature que vous insérerez lors de la réponse à "Répondre à l'adresse e-mail 1"
Sortie pour
Cas "Adresse e-mail de réponse 2""Adresse e-mail de réponse 3"
xFichierSignature = xCheminSignature & "222.htm"
Sortie pour
Cas "Adresse e-mail de réponse 4"
xFichierSignature = xCheminSignature & "333.htm"
Sortie pour
End Select
Suivant
Si fin
VBA.DoEventsVBA.DoEvents
Définir xDoc = xMailItem.GetInspector.WordEditor
xDoc.Application.Selection.EndKey
xDoc.Application.Selection.InsertParagraphAfter
xDoc.Application.Selection.MoveDown Unité :=wdLine, Nombre :=1
xDoc.Application.Selection.InsertFile NomFichier :=xSignatureFile, Lien :=Faux, Pièce jointe :=Faux
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Ce code a fonctionné pour moi jusqu'à ce que je redémarre mon PC. Lorsque j'ouvre à nouveau alt + F11, tout le code est toujours au même endroit, mais lorsque j'envoie un e-mail, il l'envoie simplement sans signature et sans émettre aucune sorte de message d'avertissement.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Ivan, Le problème est dû au fait qu'Excel a désactivé l'option Macro. Vous devez accéder à la fenêtre Options Outlook en cliquant sur Déposez le > Options. Dans le Options d'Outlook fenêtre, cliquez sur Trust Center dans le volet gauche, puis cliquez sur Paramètres du Centre bouton. dans le Trust Center fenêtre, cliquez sur Paramètres de macro dans le volet de gauche, puis sélectionnez le Activer toutes les macros bouton radio et cochez la case Appliquer les paramètres de sécurité des macros aux compléments installés boîte. Voir la capture d'écran ci-jointe ci-dessous.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Cristal,
J'ai une question sur le code source ci-dessous.
Je souhaite envoyer une signature interne uniquement à certains destinataires email (30), dès qu'une autre adresse email est ajoutée, la signature externe doit être utilisée.
Pouvez-vous m'aider avec ma demande?
Un grand merci à l'avance.
Ce commentaire a été minimisé par le modérateur sur le site
J'ai plusieurs comptes de messagerie configurés sur Outlook et j'ai configuré votre script pour envoyer différentes signatures aux e-mails internes et externes.

Comment puis-je modifier le script pour qu'il n'envoie ces signatures que si j'envoie depuis jweaver@andrewslogistics.com ?

En d'autres termes, je ne veux pas envoyer ces signatures lorsque j'envoie depuis une adresse e-mail autre que jweaver@andrewslogistics.com.

Merci,
Ce commentaire a été minimisé par le modérateur sur le site
Salut Jeff Weaver,
Le code VBA suivant a été modifié pour insérer ces signatures lors de l'envoi d'e-mails uniquement à partir d'un compte de messagerie spécifié. Veuillez essayer. j'espère que je peux aider.
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
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal - J'ai aussi le même problème que Tim (#33997) et Greg (#34358) référencés ci-dessus, mais je ne vois pas de solution. La signature apparaît dans mon e-mail au dernier endroit sur lequel je clique avant d'appuyer sur "envoyer", apparaissant ainsi souvent au milieu de l'e-mail. Une aide/solution ?

Merci !

Eric
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Eric Anderson,
Merci pour votre avis. Le code a maintenant été mis à jour et le problème a été résolu. Veuillez essayer.
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
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,

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

Avez-vous une solution ?

Lélian
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour LÉLIAN ALEMPS.
Le code VBA a été mis à jour. Merci pour votre avis. Veuillez essayer.

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
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal,

Comme d'autres dans ce fil, j'aimerais que ma signature soit par défaut une signature externe s'il y a des adresses e-mail non internes dans la ligne to ou cc et passer à une signature interne lorsqu'il ne s'agit que d'adresses e-mail internes. Pour ce faire, j'ai combiné votre code le plus récent (réponse à Lelian) avec la réponse de Random_Guest à Daniela (par défaut la signature externe). Le résultat est que lorsque je ne réponds qu'à des adresses e-mail internes, la signature fonctionne parfaitement ; cependant, lorsque ma signature externe est insérée, elle dépose la signature au bas de la chaîne d'e-mails, pas à la fin de l'e-mail que j'envoie. Pouvez-vous s'il vous plaît conseiller comment corriger? J'ai inclus le code ci-dessous :

Private Sub Application_ItemSend (ByVal Item As Object, Cancel As Boolean)
'Mis à jour par ExtendOffice 2022/08/01
Dim xMailItem As MailItem
Dim xRecipients en tant que destinataires
Dim xRecipient en tant que destinataire
Dim xRcpAddress As String
Dim xSignatureFile, xSignaturePath As String
Dim xFSO en tant que Scripting.FileSystemObject
Estomper xDoc en tant que document
Dim xFindStr As String
On Error Resume Next
Définir xFSO = Nouveau Scripting.FileSystemObject
Si Item.Class <> olMail Alors Quittez Sub
Définir xMailItem = Article
Définir xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
Pour chaque xRecipient dans xRecipients
Si xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Alors
xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
autre
xRcpAddress = xRecipient.AddressEntry.Address
Si fin
Si VBA.InStr(VBA.LCase(xRcpAddress), "@mycompany'sname") = 0 Then 'Entrez la chaîne entre guillemets doubles. Si l'adresse e-mail du destinataire contient cette chaîne, la signature ci-dessous "internal.htm" sera attribuée à l'e-mail. Sinon, attribuez la signature "external.htm".
xSignatureFile = xSignaturePath & "Externe.htm"
Sortie pour
autre
xSignatureFile = xSignaturePath & "Interne.htm"
Si fin
Suivant
VBA.DoEventsVBA.DoEvents
Définir xDoc = xMailItem.GetInspector.WordEditor
xFindStr = "De : " & xMailItem.Recipients.Item(1).Name & " <" & xRcpAddress & ">"
Si VBA.InStr(1, xMailItem.Body, xFindStr) <> 0 Alors
xDoc.Application.Selection.HomeKey Unité :=wdStory, Étendre :=wdMove
Avec xDoc.Application.Selection.Find
.Supprimer le formattage
.Text = xFindStr
.Execute Forward :=Vrai
Terminer par
Avec xDoc.Application.Selection
.MoveLeft wdCharacter, 2
.InsertParagraphAfter
.MoveDown Unit:=wdLine, Count:=1
Terminer par
autre
Avec xDoc.Application.Selection
.EndKey Unit :=wdStory, Extend :=wdMove
.InsertParagraphAfter
.MoveDown Unit:=wdLine, Count:=1
Terminer par
Si fin
xDoc.Application.Selection.InsertFile NomFichier :=xSignatureFile, Lien :=Faux, Pièce jointe :=Faux
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Salut Josh,
Ce problème est un peu compliqué. J'ai besoin de temps pour trouver une solution. Je ne suis tout simplement pas capable de le gérer pour le moment. Désolé.
Ce commentaire a été minimisé par le modérateur sur le site
Pas de problème - merci d'y avoir jeté un coup d'œil !
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal,

J'espère que tu vas bien.

Pouvez-vous indiquer s'il est possible d'ajouter une signature différente en fonction du champ d'objet contenant des mots spécifiques.

Merci beaucoup
Mat
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Matt Read,
Merci pour votre commentaire. Je ne suis pas encore capable de résoudre ce problème.
Ce commentaire a été minimisé par le modérateur sur le site
Ok merci d'avoir pris le temps
Ce commentaire a été minimisé par le modérateur sur le site
Salut! J'ai implémenté le code à la plupart du temps, il fonctionne comme prévu. Cependant, de temps en temps, il insère la signature au milieu d'un message. c'est arrivé pour la première fois quand j'ai attaché une table dans le corps. la signature a été insérée dans le tableau. De plus, il est arrivé qu'il coupe une partie du texte de sorte que deux à trois lignes de texte se trouvent à la fin du courrier (après la signature). Cela n'arrive pas tout le temps, mais j'espère que vous pourrez aider à le résoudre afin qu'il devienne plus fiable.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Mikkel Lundsgaard,
Le code fonctionne bien dans mon cas. Quelle version d'Outlook utilisez-vous ?
Il n'y a pas encore de commentaires postés ici
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés