Image dans un mail en VBA sans utiliser Outlook

Résolu
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   -  
LEGONZ77 Messages postés 33 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

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?

Merci d'avance pour votre aide.

Cordialement.
A voir également:

21 réponses

  • 1
  • 2
Réponse 1 / 21
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
J'ai réussi à l'adapter pour avoir l'image dans le corps du message, grâce à ce lien:

https://excel-macro.tutorialhorizon.com/excel-vba-send-unique-images-embedded-to-mail-body-with-every-mail-from-ms-outlook-using-excel/ 

'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
4
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Où se trouve le chemin de l'image qui se trouvera dans le mail et en PJ stp?
0
LEGONZ77 Messages postés 33 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

un grand merci
0
Réponse 2 / 21
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
Bonjour,

voir ceci:

https://forums.commentcamarche.net/forum/affich-32417574-joindre-un-fichier-et-coller-une-image-dans-un-mail-en-vba
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Bonjour,

Merci cs_Le Pivert, enfin une réponse \o/

Par contre, si je décortique le code, on ajoute une image en PJ et non dans le corps du mail si?

Ou je me trompe...

Cordialement.
0
Réponse 3 / 21
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Bonjour cs_Le Pivert,

C'est vraiment pas mal, j'arrive déjà à afficher quelque chose dans mon mail.

Seulement j'ai le message
:

Ma synthaxe est-elle correcte selon toi? 

.HTMLBody = "<html><p>Voici mon image.</p><img src='cid:C:\LOGO_AUTOMATE.jpg'width='100' height='100'><br>"


Le TextBody ne s'affiche pas non plus comme tu peux le remarquer : 

.TextBody = "Vous trouverez en PJ les indexations gasoil pour les clients vous concernant."


Je te remercie en tout cas pour tout le temps passé à m'aider.

Cordialement.
0
Réponse 4 / 21
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
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.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 21
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Nous y sommes !

Ma syntaxe était bonne. Le problème venait tout simplement de la taille de l'image en Octets. (Pas plus de 40Ko).

Merci beaucoup pour l'aide, je n'y serais jamais arrivé sans vous :)

Cordialement.
0
Réponse 6 / 21
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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


Bonne soirée
0
Réponse 7 / 21
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Bonjour cs_Le Pivert,

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 :)

Merci de ta précieuse aide en tout cas.

A bientôt.

Cordialement.
0
Réponse 8 / 21
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
Tu n'es pas obligé de te servir de l'inputBox, il suffit de le remplacer par: 

 Fichier = "C:\Chemin du fichier.jpg" 
    nom = Dir(Fichier) 'nom fichier image


Et ensuite tu te sers de cela: 

    .HTMLBody = "<html><p>Voici mon image.</p>" & _
                   "<img src='cid:" & nom & "'" & "width='100' height='100'><br>"


j'ai fait cela exprès pour qu'il n'y est pas de chemin en dur dans le code HTML!

0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
C'est exactement ce que j'ai fait :)

Voilà mon code : 

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


Merci :)
0
jpbauer Messages postés 9 Date d'inscription   Statut Membre Dernière intervention   > Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

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

    PathTmp = Environ$("temp") & "\" & "Image.jpg"
    Img = Dir(PathTmp)

    Set Plage = Sheets("STATISTIQUE").Range("G17:M20")
   If Dir(PathTmp) <> "" Then Kill PathTmp

On Error GoTo Err_Save
  
    ' préparation du mail
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
 
    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "@mail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pw"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 
        .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
    
    ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete

 
        With iMsg
        Set .Configuration = iConf
        .To = "@mail"
        .CC = ""
        .BCC = ""
        .from = """@mail"" <@mail>"
        .Subject = "Suivi des ventes " & Date & " à " & Time
        .AddAttachment "fichier.xlsx"
'        .AddAttachment PathTmp
        .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<br><br>" _
            & "<img src='cid:" & Img & "'" & "width='400' height='100'></font></span>"
        .Send
    End With   
    Exit Sub
    
Err_Save:
    If Err.Number = 1004 Then
        MsgBox "Document non envoyé"
        Exit Sub
    Else
        MsgBox Err.Description, vbOKOnly, "Erreur " & Err.Number
    End If



Si vous avez une idée, je suis preneur

COrdialement
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729 > jpbauer Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

Suis exactement l'exemple poster ici dans le même ordre:

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

@+
0
Réponse 9 / 21
jpbauer Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour

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.

Cordialement
0
Réponse 10 / 21
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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

0
Réponse 11 / 21
jpbauer Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
 
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"....





--
0
Réponse 12 / 21
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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 

 PathTmp = Environ$("temp") & "\" & "Image.jpg"
MsgBox PathTmp


@+ Le Pivert
0
Réponse 13 / 21
jpbauer Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
 
Oui le répertoire est bon...

Merci quand même de ton aide.

--
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
As-tu essayé mon dernier code?
0
Réponse 14 / 21
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
Je viens d'essayer: 

 PathTmp = Environ$("temp") & "\" & "Image.jpg"


L'image est avec la pièce jointe(classeur)!!!!!!!!!!!!!

change ton répertoire, cela vient de là
0
Réponse 15 / 21
jpbauer Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
 
Je vais essayer ce soir.

Ce que tu dis est qu'il faut ou qu'il ne faut pas que l'image soit dans le même répertoire que le classeur excel ?

--
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
Non qu'elle ne soit pas dans ce répertoire

PathTmp = Environ$("temp") & "\" & "Image.jpg"

, le classeur n'a rien à voir. Tu peux mettre ton image dans le même dossier que ton classeur contenant tes macros par exemple avec ThisWorkbook.Path
0
Réponse 16 / 21
jpbauer Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
 
Même résultat en changeant le répertoire.

Concernant Environ$("temp"), la chaine de caractère est case sensitive, cela dépends donc de la configuration du PC.

Je crois que je vais me contenter de la pièce jointe... j'ai perdu assez de temps.

MErci pour ton aide
--
0
Réponse 17 / 21
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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


Voilà avec un peu de persévérance

@+ Le Pivert
0
Réponse 18 / 21
jpbauer Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
 
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.

--
0
Réponse 19 / 21
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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! 


   Fichier = Application.GetOpenFilename("Fichiers Image (*.jpg), *.jpg")
    nom = Dir(Fichier) 'nom fichier image
0
Réponse 20 / 21
jpbauer Messages postés 9 Date d'inscription   Statut Membre Dernière intervention  
 
Nan c'est pas pour çà.

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

--
0

Discussions similaires

impossible d envoyer message a un contact sans être bloquée
vic -
bazfile -

1 réponse
Rétrodiffusion "Mail Delivery System"
baissaoui -
baissaoui -

0 réponse