Signature Outlook dans macro Excel

Signaler
Messages postés
48
Date d'inscription
vendredi 14 juin 2013
Statut
Membre
Dernière intervention
14 décembre 2020
-
Messages postés
7351
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
23 avril 2021
-
Bonjour,

J'ai une macro Excel qui me permet d'envoyer un mail avec un fichier en PJ.
Le problème est que je ne sais pas quel code ajouter pour que ma signature Outlook apparaisse.

Il faudrait un code qui récupère ma signature qui se trouve dans le chemin ci-dessous :
C:\Users\Alexis\AppData\Roaming\Microsoft\Signatures\- Cordialement.htm

J'ai essayé pleins de codes signautres trouvés sur internet mais aucun ne fonctionne.

Pouvez vous m'aider svp ?

Voici mon code VBA :

Sub envoiMail()
Dim Fichier As Variant
Dim Signature As Variant

Fichier = Application.GetOpenFilename("Feuilles de calcul,*.xlsm")
MsgBox Fichier

Dim MaMessagerie As Object
Dim MonMessage As Object
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.createitem(0)

MonMessage.To = "bidule@bidule.fr"
MonMessage.Cc = ""
MonMessage.BCC = ""
MonMessage.attachments.Add Fichier
MonMessage.Subject = "Commandes"
Contenu = "Bonjour Bidule,"
Contenu = Contenu & Chr(10) & Chr(13)
Contenu = Contenu & "Ci-joint le fichier des commandes"
Contenu = Contenu & Chr(10) & Chr(13)

MonMessage.body = Contenu
MonMessage.Send
ReturnReceipt = True
Set MaMessagerie = Nothing
MsgBox "Votre mail a bien été envoyé."
End Sub


EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.

4 réponses

Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
Bonjour,

Après cette ligne
Set MonMessage = MaMessagerie.createitem(0)

Ajoute un .Display qui va mettre ta signature
MonMessage.Display


Il te reste à concaténer la signature à ton contenu
MonMessage.body = Contenu & MonMessage.body


Messages postés
48
Date d'inscription
vendredi 14 juin 2013
Statut
Membre
Dernière intervention
14 décembre 2020

Bonjour @cs_MPi

Merci, mais ça ne fonctionne pas...
Messages postés
48
Date d'inscription
vendredi 14 juin 2013
Statut
Membre
Dernière intervention
14 décembre 2020

J'ai ajouté et modifié ce que tu m'as dis.
Ce que ça fait ? Ca envoie le mail sans la signature (comme avant)

J'ai peut etre mal compris ?

Merci d'avance

Sub envoiMail()
Dim Fichier As Variant
Dim Signature As Variant

Fichier = Application.GetOpenFilename("Feuilles de calcul,*.xlsm")
MsgBox Fichier

Dim MaMessagerie As Object
Dim MonMessage As Object
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.createitem(0)

MonMessage.Display 'ce que tu m'as dis d'ajouter

MonMessage.To = "bidule@bidule.fr"
MonMessage.Cc = ""
MonMessage.BCC = ""
MonMessage.attachments.Add Fichier
MonMessage.Subject = "Commandes"
Contenu = "Bonjour Bidule,"
Contenu = Contenu & Chr(10) & Chr(13)
Contenu = Contenu & "Ci-joint le fichier des commandes"
Contenu = Contenu & Chr(10) & Chr(13)

MonMessage.body = Contenu & MonMessage.body '"& MonMessage.body" = ce que tu m'as dis d'ajouter
MonMessage.Send
ReturnReceipt = True
Set MaMessagerie = Nothing
MsgBox "Votre mail a bien été envoyé."
End Sub
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
Si tu mets un point d'arrêt après cette ligne, est-ce que ta signature est bien là?
MonMessage.Display 'ce que tu m'as dis d'ajouter


Aussi, peut-être essayer avec HTMLBody plutôt que Body
Messages postés
48
Date d'inscription
vendredi 14 juin 2013
Statut
Membre
Dernière intervention
14 décembre 2020

En mettant un point d'arrêt après la ligne "MonMessage.Display" la signature se met seulement si ma signature Outlook se met par défaut.

Sauf que moi j'ai plusieurs signatures (ce n'est pas la même selon les destinataires)
Donc lorsque j'envoie des mail depuis Outlook je sélectionne à chaque fois ma signature.

Mais pour ma macro je voudrais que ça soit une signature en particulière qui s'affiche (ex : "Destinataire02")

Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
Si ta signature ne contient pas d'image, tu peux regarder ici:
https://www.rondebruin.nl/win/s1/outlook/signature.htm
Messages postés
48
Date d'inscription
vendredi 14 juin 2013
Statut
Membre
Dernière intervention
14 décembre 2020
>
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018

Si justement, ma signature a un logo + du texte.

J'avais déjà essayé ce qu'il y a d'indiqué sur le lien que tu as envoyé mais le logo affiche un carré blanc avec une croix :/
Messages postés
7351
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
23 avril 2021
122
Bonjour,

Erreur de ma part, je n'avais pas vu le lien donné par cs_MPI

Messages postés
7351
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
23 avril 2021
122
J'ai trouvé comment faire fonctionner ce code:

Tu mets dans ta feuille Excel ton logo, tu détermines la plage de cellule de l'emplacement de ton logo

Sub Mail_Outlook_With_Signature_Html_1()
' Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim Fichier As String
Dim Img As String, Plage As Range, secours As String
Dim PathTmp As Variant
 Const cdoBasic = 1
Fichier = Application.GetOpenFilename("Feuilles de calcul,*.xlsm")
'répertoire temporaire
PathTmp = Environ$("Temp") & "\" & "Image.jpg"
Img = "Image.jpg"
   Set Plage = Sheets("Feuil1").Range("G17:M31") 'plage de cellule de ton logo
   If Dir(PathTmp) <> "" Then Kill PathTmp
   
   'Création d'un fichier image dans le répertoire temporaire
    Plage.CopyPicture
    With ActiveSheet.ChartObjects.Add(0, 0, Plage.Width, Plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export PathTmp, "JPG"
    End With
    
    ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
              "Please visit this website to download the new version.<br>" & _
              "Let me know if you have problems.<br>" & _
 "<img src='cid:" & Img & "'" & "width='400' height='100'></font></span>"

    On Error Resume Next

    With OutMail
        .Display
        .To = "bidule@bidule.fr"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Attachments.Add PathTmp 'chemin image jointe
       .Attachments.Add Fichier 'chemin classeur
        .Send
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
     Kill PathTmp 'on supprime le fichier image

End Sub


tiré de ce post

https://www.commentcamarche.net/forum/affich-33753415-image-dans-un-mail-en-vba-sans-utiliser-outlook

Voilà

@+ Le Pivert
Messages postés
48
Date d'inscription
vendredi 14 juin 2013
Statut
Membre
Dernière intervention
14 décembre 2020

J'ai transformé carrément toute ma signature en image mais ca ne fonctionne pas.
Voilà ce que ça met à la place :
Messages postés
7351
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
23 avril 2021
122
Je t'ai fait 2 exemples une image sur la feuille et choix de l'image dans le répertoire

https://www.cjoint.com/c/HHBqgNxquYQ

@+ Le Pivert
Messages postés
48
Date d'inscription
vendredi 14 juin 2013
Statut
Membre
Dernière intervention
14 décembre 2020

Si je choisis une image dans la feuille voici ce que ça me fait :


Si je choisis une image dans un répertoire, j'ai une erreur "Incompatibilité de type" - (Ligne 3 : If Image = False Then)
Private Sub importimage()
 Image = Application.GetOpenFilename("Fichiers Gif ou Jpg ,*.gif;*.jpg")
 If Image = False Then Exit Sub
   a = Split(Image, "\")
    nomimage = a(UBound(a))
    Set c = Sheets("Feuil1").Range("A1:B5")
    With ActiveSheet
     .Pictures.Insert(Image).Name = nomimage
     .Shapes(nomimage).Left = c.Left
     .Shapes(nomimage).Top = c.Top
     .Shapes(nomimage).LockAspectRatio = msoFalse
     .Shapes(nomimage).Height = c.Height
     .Shapes(nomimage).Width = c.Width
    End With
  End Sub
Messages postés
7351
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
23 avril 2021
122
En supprimant cette ligne voilà ce que cela donne:

 If Image = False Then Exit Sub

Messages postés
1
Date d'inscription
lundi 2 mars 2020
Statut
Membre
Dernière intervention
2 mars 2020

Bonjour, je suis nouveau sur ce forum.

Je viens de commencer à coder en VBA et je voudrais automatiser un envoi de mails sous Outlook.
Mon code marche bien, mes mails sont envoyés cependant, j'ai un soucis concernant le logo: Lors de l'envoi du mail, il s'affiche pendant une seconde et il disparaît! à la place j'ai une croix rouge! j'ai chercher sur internet mais sans succès. Voici mon code

Private Sub EnvoyerMail()

Dim Mail As Variant
Dim Ligne As Integer
Dim Nom_Fichier As String
Dim DernLigne As Long
Dim SigString As String
Dim Signature As String
Dim strBody As String


Set Mail = CreateObject("Outlook.Application") 'Creer un objet qui outlook
DernLigne = Range("A1048576").End(xlUp).Row 'Tu calcules le num de la derniere cellule remplie

For Ligne = 2 To 3 'DernLigne ' A changer selon la taille du fichier

'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & "\Microsoft\Signatures\"
f = Dir(SigString & "*.htm") 'on prend la première signature trouvée
If f <> "" Then
Signature = GetBoiler(SigString & f)
Signature = Replace(Signature, "src=""", "src=""" & SigString)

Else
Signature = ""
End If

On Error Resume Next

With Mail.CreateItem(olMailItem)
strBody = _
"<Body>Bonjour,<br /><br /></Body>" & _
"<Body>Veuillez trouver ci-joint le rapport énergétique du mois dernier pour votre site.<br /><br /> Nous vous enverrons de manière régulière des rapports.<br />Notre objectif est de maintenir en continu un équilibre entre économies d’énergie et confort.<br /><br /></Body>" & _
"<Body>Remarque: Ce rapport est créé de façon automatique, si vous remarquez une erreur, n’hésitez pas à nous faire un retour.<br /><br /></Body>"

Nom_Fichier = Range("A" & Ligne) 'Chercher la pièce jointe
.Display 'Pour afficher le mail avant l'envoi. A remplacer par .Send pour envoyer directement
.Save
.Subject = Range("B" & Ligne) 'Placer l'objet qui se trouve dans Macolonne et ligne
.To = Range("C" & Ligne) ' Placer l'adresse mail qui se trouve dans Macolonne et ligne
.CC = Range("D" & Ligne) ' Mail en copie
'.BCC = Range("" & Ligne) ' Mail en copie cachée
.HTMLBody = strBody & Signature
.Attachments.Add Nom_Fichier ' Pieces jointes
.Display
'.Send

End With

Next Ligne

End Sub

Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

Function GetSignature(fPath As String) As String
Dim fso As Object
Dim TSet As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set TSet = fso.GetFile(fPath).OpenAsTextStream(1, -2)
GetSignature = TSet.readall
TSet.Close
End Function

merci pour vos réponses
Messages postés
7351
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
23 avril 2021
122
Bonjour,

voir ceci:

.Attachments.Add PathTmp 'chemin image jointe


https://codes-sources.commentcamarche.net/forum/affich-10086698-signature-outlook-dans-macro-excel#12

@+ Le Pivert