Re : Problème de signature lors d'envoie de mail par macro excel
Bonjour BrunoM45
Autant pour moi j'aurais du mettre mon code
Ci joint mon code:
Public Sub EnvoiMailMicrosoftOutlook(Destinataire As String, DestinataireCopie As String, Objet As String, TexteMessage As String, FichierJoint As String)
'* Initialisation :
Dim MonOutlook As Outlook.Application
Dim MonMessage As Outlook.MailItem
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(olMailItem)
'* Préparation du message :
With MonMessage
.To = Destinataire
.CC = DestinataireCopie
.BCC = ""
.Subject = Objet
.HTMLBody = TexteMessage
.Display '* Affiche le message
End With
If FichierJoint = "" Then GoTo suite
MonMessage.Attachments.Add FichierJoint
suite:
'* Fermeture de la session Outlook :
Set MonOutlook = Nothing
End Sub
Sub Envoie_mail()
'* Déclaration des variables
Dim dest As String
Dim destcopie As String
Dim Obj As String
Dim texte As String
Dim Sign As String
Dim Sig As String
Dim Fich_joint As String
'* Destinataire du mail
dest = Sheets("Email").Range("B1")
destcopie = Sheets("Email").Range("B2")
'* Objet du mail
Obj = NomFichier_PDF
'* Texte du mail
texte = "Bonjour <BR><BR>"
texte = texte & "Ci-joint mon fichier <FONT COLOR=royalblue>" & ActiveSheet.Name & "</FONT><BR><BR>"
texte = texte & "Cordialement. <BR><BR>"
'* Signature du mail
nom = Application.UserName
Sig = "C:\Documents and Settings\" & nom & "\Application Data\Microsoft\Signatures\maSignature.htm"
If Dir(Sig) <> "" Then
Sign = GetBoiler(Sig)
Else
Sign = ""
End If
texte = texte & Sign
'* fichier à joindre
Fich_joint = Chemin_PDF & "\" & NomFichier_PDF & ".pdf"
Call EnvoiMailMicrosoftOutlook(dest, destcopie, Obj, texte, Fich_joint)
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