Autres Envoi Mail (méthode CDO) avec image incorporée dans le corps du message !?

[Roland_M]

Bonsoir tout le monde,

J'ai créé un classeur pour envoi Email avec la méthode CDO (vous l'avez peut être déjà vu)

mon problème est le suivant:
le message est créé en code html, je ne suis pas spécialiste, mais en glanant qq infos on finit par arriver à ses fins
le message est donc collé avec .HTMLBody, jusque là ok !

j'étudie pour coller une image dans le corps du message, ça fonctionne bien mais . . . et là est mon problème,
cette image collée dans le corps du message n'est présente que si elle reste sur le disque ou si elle est placée sur un site spécialisé pour ça !
je me suis envoyé ce mail et quand je charge mes messages je la retrouve à condition qu'elle soit toujours présente sur le disque
et si je vais sur ma messagerie(orange) il n'y a pas d'image, donc elle n'est pas réellement incorporée !?

exemple qui fonctionne:
PathImage$ = "E:\TRAV_VBA\Imag_Actu.bmp"
. . .
MsgHTMLBody = MsgHTMLBody & RetLigHTML
MsgHTMLBody = MsgHTMLBody & "<img src=" & PathImage$ & ">" & RetLigHTML
. . .

j'aimerai comprendre pourquoi, une fois l'Email envoyé, l'image n'est plus dans le message
alors que si je charge mes messages elle apparaît dans le message tant que cette image est sur mon disque !?
apparemment elle n'est pas incorporée mais c'est simplement une adresse !?
j'en conclu que l'on ne peut pas envoyer ce genre de mail avec une image à d'autres puisqu'il ne la recevra pas !?

quelle est la solution pour incorporer cette image réellement dans le message tout comme du texte ?


merci beaucoup d'avance !

 

[Staple1600]

Bonsoir le fil, Roland_M

Roland_M
Je t'invite à investiguer sur ce mot-clé: base64
En bonus , un petite fonction glanée jadis sur le web anglophone

Public Function EncodeFile(strPicPath As String) As String
    Const adTypeBinary = 1          ' Binary file is encoded

    ' Variables for encoding
    Dim objXML
    Dim objDocElem

    ' Variable for reading binary picture
    Dim objStream

    ' Open data stream from picture
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeBinary
    objStream.Open
    objStream.LoadFromFile (strPicPath)

    ' Create XML Document object and root node
    ' that will contain the data
    Set objXML = CreateObject("MSXml2.DOMDocument")
    Set objDocElem = objXML.createElement("Base64Data")
    objDocElem.dataType = "bin.base64"

    ' Set binary value
    objDocElem.nodeTypedValue = objStream.Read()

    ' Get base64 value
    EncodeFile = objDocElem.Text

    ' Clean all
    Set objXML = Nothing
    Set objDocElem = Nothing
    Set objStream = Nothing

End Function

 

[Roland_M]

Bonsoir Staple, toujours à l'affût prêt à dégainer !

déjà entendu parlé mais je ne connais pas du tout !?

je vais donc voir de ce côté !

encore merci à toi.

 

[Roland_M]

Bonjour,

Staple, je ne maîtrise absolument pas ce code, je ne vois même pas comment l'incorporer avec CDO !?
bien que j'utilise déjà ceci:
If FsiReferenceCdoActive Then 'format police si Ref'Microsoft CDO for windows 2000 library'
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
End If
-------------------------------

mais j'ai refais des essais et apparemment on peut coller l'image dans le corps du texte qu'avec une adresse internet !
si c'est une image sur un disque dur elle disparaît à l'envoi !?
j'ai fait des essais avec mon adresse perso et quand je rechargeai mes messages elle était présente puisque l'image est sur mon disque
si je la renomme ou la supprime elle disparaît !
idem si j'envoi à une autre adresse elle est absente !

la conclusion est que l'image n'est jamais collée physiquement, c'est juste une adresse ! donc je laisse tomber !

encore merci à toi !


EDIT: je crois que j'ai parlé un peu vite !?
je suis sur un essai qui semble fonctionner ! je vais adapter mon code et si ok je reviens !

 

[patricktoulon]

bonsoir a tous

beep beep!!!
mauvaise id le src en base 64 tout les application mail dont outlook ne l'acceptent pas
d'ailleurs outlook a son propre code ressemblant au base 64 mais ca n'en est pas
si vous cherchez dans l'autre monde Xl (DVP) vous trouverez diverses de mes contributions sur cdo et image dans le corps du message
je regarde si j'ai un exemple simple dans mes archives

allez tiens un exemple
j'attire ton attention sur le src dans le html code
et sur la ligne ".AddRelatedBodyPart....."


si emetteur serveur gmail ou mot de passe requis débloquer les 3 lignes dans le configuration field

Sub test_cdo_with_image()
    strSMTP = "smtp.orange.fr"
    sMessage = "<html>salut une image1 <br> <img src=""cid:balloon.bmp""><br>UNE AUTRE IMAGE <br><img src=""cid:balloon2.bmp""></html>"
    sImageFile = "F:\sauvegarde\Bateau 2.jpg"
    sImageFile2 = "H:\diverse image\Cascade et rivière\YOSEMITE6M.jpg"
    SendMail "moimeme@hotmail.fr", "destinataire2@hotmail.fr", "une image", sMessage, sImageFile, sImageFile2, "password", strSMTP
End Sub
' send email using public mail servers
Function SendMail(strFrom, strSendTo, strSubject, strMessage, sImageFile, sImageFile2, strPassword, strSMTP)
    Set oEmail = CreateObject("CDO.Message")
    'configure message
    With oEmail.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
        '.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic
        '.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser
        '.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPassword
        .Update
    End With
    ' build message
    With oEmail
        .From = strFrom
        .To = strSendTo
        .Subject = strSubject
        .HTMLbody = strMessage
        Set objBP = .AddRelatedBodyPart(sImageFile, "balloon.bmp", 1)
        objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<balloon.bmp>"
        objBP.Fields.Update
        Set objBP = .AddRelatedBodyPart(sImageFile2, "balloon2.bmp", 1)
        objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<balloon2.bmp>"
        objBP.Fields.Update

    End With
    ' send message
    On Error GoTo gestioneerr
    oEmail.Send
    MsgBox "message envoyé"
    Exit Function
gestioneerr:
    MsgBox "SendMail Failed:" & Err.Description

End Function

 

[Roland_M]

Bonsoir, salut Patrick !

aucun soucis j'ai solutionné pour l'image tout est ok !
mon classeur FICH_EnvoiMail_CdoMsg_5plus.xlsm
envoi aussi bien orange/gmail/outlook ... sans problème !

 

[patricktoulon]

Bonsoir Rolland
tu envoie tes images comment

 

[Roland_M]

re

je te mets ça dès que possible car là suis très occupé ! à bientôt !

 

[Roland_M]

re

pour les images je laisse tomber car ça fonctionne seulement avec orange !?

j'avais trouvé ton code mais je n'y ai rien compris !?
on voit des noms comme balloon.bmp et balloon2.bmp (les deux images) en haut puis répété en bas !?
et des chemins avec des noms d'images différents !?
"F:\sauvegarde\Bateau 2.jpg"
"H:\diverse image\Cascade et rivière\YOSEMITE6M.jpg"

sMessage = "<html>salut une image1 <br> <img src=""cid:balloon.bmp""><br>UNE AUTRE IMAGE <br><img src=""cid:balloon2.bmp""></html>"
sImageFile = "F:\sauvegarde\Bateau 2.jpg"
sImageFile2 = "H:\diverse image\Cascade et rivière\YOSEMITE6M.jpg"


je ne vois vraiment pas comment mettre cette macro en oeuvre !?

 

[patricktoulon]

re
en fait on ajoute l'image en piece jointe avec addrelatedbodypart en la nommant baloon1.bmp
et dans le src cid:balonn1

en gros le lien src c'est le lien de la piece(image) jointe
c'est pas compliqué
tien je me le suis envoyé a moi meme regarde ce que ca donne sur le mail

 

[Roland_M]

ok ! je viens de faire un essai concluant !

mais il a fallu que je mettre le même nom d'image dans la macro Sub test_cdo_with_image() et pareil dans la Function qui était mis en dur !
pourquoi ne pas avoir passé les noms des images dans la Function !?

 

[patricktoulon]

re
parce que j'ai des images avec des noms a dormir debout sur la tète, j'ai donc simplifié les lien en baloon(1,2,3,etc...)

et j'avais fait y a 10 ans deja ca date un peu
si tu cherche bien dans l'autre monde Xl j'ai même fait un interface pour cdo avec wysiwyg dans un userform et il fonctionne encore aujourd'hui

alors il y a une petite nuance entre addatachement et addrelatedbodypart selon l'application mail que destinataire utilise
il aura les liens dans les pieces jointes et les images dans le body ou pas de liens dans les pieces jointes mais quand même les images dans le body

perso je m'en sert pour mes entes de courrier pro qui sont des bandeaux pub en jpeg et mon bandeau signature
tout ca parce que j'ai jamais reussi a faire tourner outlook 2007 LOL

 

[Roland_M]

re

donc dans la Function on mettre n'importe quel nom et pas obligatoirement le nom réel ?

par-contre là aussi ça fonctionne avec orange et pas outlook !? malgré les 3 lignes débloquées !?

 

[patricktoulon]

OUI
apartir dumoment ou c'est cohérent

dans le body du message
--------------------------------------------------------------------------------------------------------------------------------------
sMessage = "<html>salut une image1 <br> <img src=""cid:totolafritte.bmp""><br>UNE AUTRE IMAGE <br><img src=""cid:jolagaloche.bmp""></html>"
------------------------------------------------------------------------------------------------------------------------------------

ajout des pieces image dans le mail
Set objBP = .AddRelatedBodyPart(sImageFile, "totlafritte.bmp", 1)
objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<totlafritte.bmp>"
objBP.Fields.Update
Set objBP = .AddRelatedBodyPart(sImageFile2, "jolagaloche.bmp", 1)
objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<jolagaloche.bmp>"
objBP.Fields.Update

sImageFile(1 et 2) étant les lien des images sur ton DD

 

[Roland_M]

ok

mais par-contre là aussi ça fonctionne avec orange et pas outlook !? malgré les 3 lignes débloquées !?