Signature Outlook dans macro Excel

1Alexiiis Messages postés 48 Date d'inscription vendredi 14 juin 2013 Statut Membre Dernière intervention 14 décembre 2020 - Modifié le 8 juil. 2018 à 12:41
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 2 mars 2020 à 11:09
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.
A voir également:

4 réponses

cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
Modifié le 9 juil. 2018 à 15:02
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


0
1Alexiiis Messages postés 48 Date d'inscription vendredi 14 juin 2013 Statut Membre Dernière intervention 14 décembre 2020
15 août 2018 à 16:04
Bonjour @cs_MPi

Merci, mais ça ne fonctionne pas...
0
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
16 août 2018 à 16:56
Ça devrait pourtant.
Pour t'aider, il faudrait que tu mettes le code modifié que tu utilises.

Quand tu dis que ça ne fonctionne pas, Est-ce qu'il y a un message d'erreur? si oui lequel et sur quelle ligne ?
0
1Alexiiis Messages postés 48 Date d'inscription vendredi 14 juin 2013 Statut Membre Dernière intervention 14 décembre 2020
16 août 2018 à 19:35
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
0
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
16 août 2018 à 20:07
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
0
1Alexiiis Messages postés 48 Date d'inscription vendredi 14 juin 2013 Statut Membre Dernière intervention 14 décembre 2020
16 août 2018 à 21:06
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")

0
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
17 août 2018 à 14:04
Si ta signature ne contient pas d'image, tu peux regarder ici:
https://www.rondebruin.nl/win/s1/outlook/signature.htm
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
Modifié le 18 août 2018 à 14:59
Bonjour,

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

0
1Alexiiis Messages postés 48 Date d'inscription vendredi 14 juin 2013 Statut Membre Dernière intervention 14 décembre 2020
18 août 2018 à 15:30
Bonjour,
Ca ne fonctionne pas (Cf. réponse ci-dessus)
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
Modifié le 18 août 2018 à 17:31
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
0
1Alexiiis Messages postés 48 Date d'inscription vendredi 14 juin 2013 Statut Membre Dernière intervention 14 décembre 2020
27 août 2018 à 18:00
J'ai transformé carrément toute ma signature en image mais ca ne fonctionne pas.
Voilà ce que ça met à la place :
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
27 août 2018 à 18:08
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
0
1Alexiiis Messages postés 48 Date d'inscription vendredi 14 juin 2013 Statut Membre Dernière intervention 14 décembre 2020
27 août 2018 à 18:33
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
0
siriusblack_5006 Messages postés 1 Date d'inscription lundi 2 mars 2020 Statut Membre Dernière intervention 2 mars 2020
2 mars 2020 à 10:26
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
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
2 mars 2020 à 11:09
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
0
Rejoignez-nous