Avant tout, je ne souhaite pas utiliser Outlook pour la génération des mails.
Voici mon code :
Sub EnvoiMail()
Dim mMessage As Object
Dim mConfig As Object
Dim mChps
Dim NOM_AFFRETEUR_MAIL As String
Dim ADRESSE_MAIL As String
Dim DF As Long
Dim DL_MAIL As Long
Dim DL_GENERAL As Long
'**********************************************************Pramétrage de gmail**********************************************************************************************
Set mConfig = CreateObject("CDO.Configuration")
mConfig.Load -1
Set mChps = mConfig.Fields
With mChps
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxx@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxx"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
.Update
End With
DL_GENERAL = Sheets(2).Cells(Application.Rows.Count, 10).End(xlUp).Row
For k = 3 To DL_GENERAL
ADRESSE_MAIL = Sheets(2).Range("J" & k)
Set mMessage = CreateObject("CDO.Message")
With mMessage
Set .Configuration = mConfig
.To = ADRESSE_MAIL
.From = "xxxxxxx"
.Subject = "INDEXATIONS GASOIL"
.TextBody = "Vous trouverez en PJ les indexations gasoil pour tous les clients."
.AddAttachment "K:\DEVELOPPEMENTS\TEMP\INDEXATIONS GASOIL GENERALES.pdf"
.send
End With
Set mMessage = Nothing
Next k
Set mConfig = Nothing
Set mChps = Nothing
End Sub
Je souhaiterais ajouter une image à la fin du mail (une sorte de signature) mais je ne vois pas comment faire avec cette méthode. J'ai trouvé de nombreux renseignements à ce propos sur les divers forum mais par la méthode Outlook.
Je précise que j'ai posté ce message sur le forum excel-pratique mais le post est malheureusement resté sans réponse. Peut-être est-ce tout simplement impossible?
'Après avoir ajouté la référence "Microsoft CDO for Windows 2000 Library" dans l'éditeur VBA Outils- Références
Sub mail_en_direct()
Const cdoBasic = 1
Dim admail As String, i As Integer
Dim messmail As String, secours As String
Dim expediteur As String
Dim Fichier As Variant
Dim chemin As Variant
Dim nom As String
Fichier = Application.GetOpenFilename("Fichiers Image (*.jpg), *.jpg")
chemin = Application.GetOpenFilename("Classeurs Excel (*.xls), *.xls")
nom = Dir(Fichier) 'nom fichier image
expediteur = InputBox("Adresse mail de l'Expéditeur", "ADRESSE ELECTRONIQUE", "monadresse@mail.fr")
admail = InputBox("Adresse mail du destinataire", "DESTINATAIRE", "adressedest@mail.fr")
messmail = "Bonjour,"
With CreateObject("CDO.Message")
If Err Then
secours = MsgBox("Problème de CDO non installé sur le serveur")
Exit Sub
Else
.From = expediteur
.To = admail 'destinataire
'.Bcc = ""
.Subject = "Bonjour"
.TextBody = messmail
'http://excel-macro.tutorialhorizon.com/excel-vba-send-unique-images-embedded-to-mail-body-with-every-mail-from-ms-outlook-using-excel/
.HTMLBody = "<html><p>Voici mon image.</p>" & _
"<img src='cid:" & nom & "'" & "width='100' height='100'><br>"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = expediteur
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ton passeport windows live mail"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'attention mettre votre adresse messagerie
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.AddAttachment Fichier 'chemin image jointe
.AddAttachment chemin 'chemin classeur joint
.Send
If Err Then MsgBox "Le message n'a pas pu être expédié.Fermez et réessayez."
End If
On Error GoTo 0
End With
MsgBox "Message envoyé avec pièces jointes"
End Sub
Je viens d'utiliser votre code en faisant un simple copier / coller et là magie, ça fonctionne. Je vais donc tout recoder mon module afin que cela fonctionne. Je pense que ça devrait aller. Je reviens vous donner des nouvelles après. Merci en tout cas.
En utilisant le code tel quel, on peut mettre toutes les images jpg sans avoir a corriger le code. Il suffit d'ouvrir une image jpg à la demande de l'inputBox!
Mais il faut garder cette ligne de code:
.AddAttachment Fichier 'chemin image jointe
Pour avoir l'image dans le corps du message
Ensuite si l'on ne veut pas envoyer un classeur, on supprime les lignes de code le concernant
En réalité, le fichier Excel est en lui-même une tâche automatique exécutée par le serveur tous les 1er de chaque mois. Du coup, aucune interaction avec un utilisateur n'est possible. C'est la raison pour laquelle je n'ai pas utilisé :
Application.GetOpenFilename
Par contre, tu as raison sur le fait qu'il faut absolument avoir la ligne :
.AddAttachment Fichier 'chemin image jointe
Que j'avais effectivement oubliée. J'ai ensuite eu un problème de taille d'image comme je l'ai précisé. En réduisant la taille, tout est OK, l'image s'affiche :)
Fichier = "\\SRVDATA01\Bureautique$\INDEXATIONS GASOIL\IMAGES\LOGO_AUTOMATE.jpg"
nom = Dir(Fichier)
For k = 3 To DL_GENERAL
ADRESSE_MAIL = Sheets(2).Range("J" & k)
Set mMessage = CreateObject("CDO.Message")
With mMessage
Set .Configuration = mConfig
.To = ADRESSE_MAIL
.From = xxxxx@xxxx.com
.Subject = "INDEXATIONS GASOIL"
.HTMLBody = "<html><p>Bonjour,<br><br>Veuillez trouver ci-joint les indexations gasoils pour tous les clients.<br><br><br>Automate FRET EUROPE.</p>" & _
"<img src='cid:" & nom & "'" & "width='400' height='130'><br>"
.AddAttachment "\\SRVDATA01\Bureautique$\INDEXATIONS GASOIL\TEMP\INDEXATIONS GASOIL GENERALES.pdf"
.AddAttachment Fichier
.send
End With
Set mMessage = Nothing
Next k
je réveille un peu le sujet mais j'ai peu ou proue le même code, mais l'image ne s'affiche pas si je l'attache explicitement, elle est bien en pièce jointe mais pas intégrée au mail.
Dim Adresse As String Dim iMsg As Object Dim iConf As Object Dim strbody As String Dim Flds As Variant
Dim Img As String, Plage As Range, PathTmp As String
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 '25 .Update End With
'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
Je sais bien que c'est le même exemple, puisque c'est de celui-ci que je me suis inspiré :-), mais malgré tout l'image est vide juste un rectangle de réservation de la zone, mais rien dedans. Pourtant le fichier image est bien présent dans le répertoire et son contenu est bien l'image que je souhaite.
On ne doit pas avoir les mêmes yeux, ton code ne correspond en rien au mien!
Sub essai()
Dim Adresse As String
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim Img As String, Plage As Range, PathTmp As String
PathTmp = chemin image
Img = Dir(PathTmp)
'Set Plage = Sheets("STATISTIQUE").Range("G17:M20")
'If Dir(PathTmp) <> "" Then Kill PathTmp
On Error GoTo Err_Save
With CreateObject("CDO.Message")
.To = destinataire
.CC = ""
.BCC = ""
.From = expediteur
.Subject = "Suivi des ventes " & Date & " à " & Time
.HTMLBody = "<span LANG=FR><p class=style2>" _
& "<font FACE=Calibri SIZE=3>Bonjour,<br><br>" _
& "Veuillez trouver ci-dessous les ventes du jour au " _
& Format(Date, "dd/mm/yyyy") & "<br><br>" _
& "Bien cordialement</p>" & _
"<img src='cid:" & Img & "'" & "width='400' height='100'></font></span>"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = expediteur
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ton passeport windows live mail"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'attention mettre votre adresse messagerie
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.AddAttachment PathTmp 'chemin image jointe
.AddAttachment chemin classeur
.Send
End With
Err_Save:
If Err.Number = 1004 Then
MsgBox "Document non envoyé"
Exit Sub
Else
MsgBox Err.Description, vbOKOnly, "Erreur " & Err.Number
End If
End Sub
Le code n'est pas rigoureusement le même puisque j'utilise une variable intermédiaire field plutôt que de faire .Configuration.Fields.Item mais le résultat est le même.
Voici ce que j'obtiens avec ton code et le mien. L'image est bien en pièce jointe, mais pas dans le corps du mail.
Donc est-ce lié à gmail et sa manière d'interpréter le "cid"....
Je me suis mis dans la même configuration que toi avec une image sur la Feuil1 et cela fonctionne:
Sub essai()
Dim Img As String, Plage As Range, PathTmp, secours As String
Const cdoBasic = 1
PathTmp = "C:\Users\LePivert\Documents\" & "Image.jpg" 'adapter repertoire
Img = Dir(PathTmp)
Set Plage = Sheets("Feuil1").Range("G17:M20")'adapter nom feuille
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
With CreateObject("CDO.Message")
If Err Then
secours = MsgBox("Problème de CDO non installé sur le serveur")
Exit Sub
Else
.To = "destinataire@free.fr" 'adapter
.CC = ""
.BCC = ""
.From = "expediteur@free.fr" 'adapter
.Subject = "Suivi des ventes " & Date & " à " & Time
.HTMLBody = "<span LANG=FR><p class=style2>" _
& "<font FACE=Calibri SIZE=3>Bonjour,<br><br>" _
& "Veuillez trouver ci-dessous les ventes du jour au " _
& Format(Date, "dd/mm/yyyy") & "<br><br>" _
& "Bien cordialement</p>" & _
"<img src='cid:" & Img & "'" & "width='400' height='100'></font></span>"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "expediteur@free.fr" 'adapter
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ton passeport windows live mail"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'attention mettre votre adresse messagerie
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.AddAttachment PathTmp 'chemin image jointe
.AddAttachment "C:\Users\LePivert\Documents\Classeur.xls" 'chemin classeur
.Send
If Err Then MsgBox "Le message n'a pas pu être expédié.Fermez et réessayez."
End If
On Error GoTo 0
End With
MsgBox "Message envoyé avec pièces jointes"
End Sub
Voilà, peux pas faire plus!!!
Donc est-ce lié à gmail et sa manière d'interpréter le "cid"....
Je ne pense pas, car tu n'aurais rien d'affiché!
Là tu as le cadre
essaie aussi cela pour voir si le chemin est valide
Je suis pugnace, il n'y a pas de raison que le chemin ne soit pas reconnu quand il est dans une variable et fonctionne correctement quand c'est un chemin en dur.
J'ai donc mis le chemin dans une cellule et cela fonctionne!
Sub essai()
Dim Img As String, Plage As Range, secours As String
Const cdoBasic = 1
'répertoire temporaire
Range("A1").Value = Environ$("temp") & "\" & "Image.jpg"
Img = Dir(Range("A1").Value)
Set Plage = Sheets("Feuil1").Range("G17:M20")'adapter feuille
If Dir(Range("A1").Value) <> "" Then Kill Range("A1").Value
'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 Range("A1").Value, "JPG"
End With
ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
With CreateObject("CDO.Message")
If Err Then
secours = MsgBox("Problème de CDO non installé sur le serveur")
Exit Sub
Else
.To = "destinataire@free.fr" 'adapter
.CC = ""
.BCC = ""
.From = "expediteur@free.fr" 'adapter
.Subject = "Suivi des ventes " & Date & " à " & Time
.HTMLBody = "<span LANG=FR><p class=style2>" _
& "<font FACE=Calibri SIZE=3>Bonjour,<br><br>" _
& "Veuillez trouver ci-dessous les ventes du jour au " _
& Format(Date, "dd/mm/yyyy") & "<br><br>" _
& "Bien cordialement</p>" & _
"<img src='cid:" & Img & "'" & "width='400' height='100'></font></span>"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "expediteur@free.fr" 'adapter
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ton passeport windows live mail"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'attention mettre votre adresse messagerie
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.AddAttachment Range("A1").Value 'chemin image jointe
.AddAttachment"C:\Users\LePivert\Documents\Classeur.xls" 'chemin classeur adapter
.Send
If Err Then MsgBox "Le message n'a pas pu être expédié.Fermez et réessayez."
End If
On Error GoTo 0
End With
MsgBox "Message envoyé avec pièces jointes"
Range("A1").Value = ""
End Sub
Pour moi le problème ne vient pas du chemin, puisque le fichier est bien joint au mail. Le PathTmp contient bien le chemin complet et le nom du fichier, img contient bien le nom du fichier image, le fichier est bien joint avec l'AddAttachment, c'est le <img src='cid:" & Img ... qui laisse ce cadre vide.
J'ai enfin trouvé, ton dernier mail m'a ouvert les yeux, le problème se situe au niveau de la variable Img.
En mettant un MsgBox a la suite de:
Img = Dir(PathTmp)
MsgBox Img
le message est vide!
Donc il faut mettre
Img = "Image.jpg"
voici le code:
Sub essai()
Dim Img As String, Plage As Range, secours As String
Dim PathTmp As Variant
Const cdoBasic = 1
'répertoire temporaire
PathTmp = Environ$("temp") & "\" & "Image.jpg"
Img = "Image.jpg"
Set Plage = Sheets("Feuil1").Range("G17:M20") 'adapter feuille
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
With CreateObject("CDO.Message")
If Err Then
secours = MsgBox("Problème de CDO non installé sur le serveur")
Exit Sub
Else
.To = "destinataire@free.fr"
.CC = ""
.BCC = ""
.From = "expediteur@free.fr"
.Subject = "Suivi des ventes " & Date & " à " & Time
.HTMLBody = "<span LANG=FR><p class=style2>" _
& "<font FACE=Calibri SIZE=3>Bonjour,<br><br>" _
& "Veuillez trouver ci-dessous les ventes du jour au " _
& Format(Date, "dd/mm/yyyy") & "<br><br>" _
& "Bien cordialement</p>" & _
"<img src='cid:" & Img & "'" & "width='400' height='100'></font></span>"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "expediteur@free.fr"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ton passeport windows live mail"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'attention mettre votre adresse messagerie
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.AddAttachment PathTmp 'chemin image jointe
.AddAttachment "C:\Users\LePivert\Documents\monclasseur.xls" 'chemin classeur
.Send
If Err Then MsgBox "Le message n'a pas pu être expédié.Fermez et réessayez."
End If
On Error GoTo 0
End With
MsgBox "Message envoyé avec pièces jointes"
Kill PathTmp 'on supprime le fichier image
End Sub
Je pense que là on est bon!
Ce qui m' a trompé c'est que dans le code d'origine le nom du fichier image sort correctement, donc je n'ai pas vérifié qu'en mettant un autre chemin le nom était absent, c'est bizarre!
la variable img contient bien le nom du fichier chez moi (img est bien = à "Image.jpg") . Si chez toi cela ne contient rien c'est que soit ton répertoire temporaire n'est pas "temp" mais "Temp" (case sensitive), soit que ce chemin est trop long pour la fonction Dir()
Ce qui me pose soucis est bien <img src='cid:" & Img ...
Sur un serveur Web, en codant en html <img src='cid:Image.jpg .... il va chercher le fichier Image.jpg dans le répertoire courant au fichier HTML en cours d'interprétation. Mais là comment CDO sait-il que le fichier Image.jpg est dans PathTmp, puisque le fichier Excel dans lequel est le code VBA n'est pas forcément dans ce répertoire.
J'ai bien testé <img src='cid:" & PathTmp... mais cela ne marche pas mieux
un grand merci