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.

21 réponses

  • 1
  • 2
  1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
    1. Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   65
       
      Où se trouve le chemin de l'image qui se trouvera dans le mail et en PJ stp?
      0
    2. LEGONZ77 Messages postés 33 Date d'inscription   Statut Membre Dernière intervention  
       
      Bonjour,

      un grand merci
      0
  2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    voir ceci:

    https://forums.commentcamarche.net/forum/affich-32417574-joindre-un-fichier-et-coller-une-image-dans-un-mail-en-vba
    0
    1. Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   65
       
      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
  3. Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   65
     
    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
  4. Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   65
     
    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

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

    Posez votre question
  6. Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   65
     
    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
  7. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
  8. Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   65
     
    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
  9. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
    1. Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   65
       
      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
      1. jpbauer Messages postés 9 Statut Membre > 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
  10. jpbauer Messages postés 9 Statut Membre
     
    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
  11. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
  12. jpbauer Messages postés 9 Statut Membre
     
    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
  13. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
  14. jpbauer Messages postés 9 Statut Membre
     
    Oui le répertoire est bon...

    Merci quand même de ton aide.

    --
    0
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      As-tu essayé mon dernier code?
      0
  15. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
  16. jpbauer Messages postés 9 Statut Membre
     
    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
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      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
  17. jpbauer Messages postés 9 Statut Membre
     
    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
  18. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
  19. jpbauer Messages postés 9 Statut Membre
     
    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
  20. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
  21. jpbauer Messages postés 9 Statut Membre
     
    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
  • 1
  • 2

Discussions similaires

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

1 réponse
Je n'arrive pas à envoyer un message de mon iPhone au 74600
Jpn -
Xileh -

2 réponses