afficher image avec .htmlbody en vba hors outlook

**gpoth** · 08/03/2017, 11h52

bonjour,

non, je cherche à obtenir des statistiques pour effectuer une étude de marché
cette méthode est très pratique pour la communication (email) en général (promotions, newsletters....)

A+

Invité · 23/02/2017, 12h53

Code html :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
<!DOCTYPE html><html>
<body>
 
 
<h2>Send e-mail to someone@example.com:</h2>
 
 
<form action="mailto:someone@example.com" method="post" enctype="text/plain">
Name:<br>
<input type="text" name="name"><br>
E-mail:<br>
<input type="text" name="mail"><br>
Comment:<br>
body <textarea name='body'>Saisissez  votre texte ici !</textarea>
<input type="submit" value="Send">
</form>
 
 
</body>
</html>

**patricktoulon** · 23/02/2017, 22h50

re
perso dans mon app mail exel j'ai la possibilté de choir avec authent ou pas car chez moi c'est plus facile d'utiliser ma smtp FAI
PAR CONTRE AU BOULOT J'AI UN PROXI JE PASSE PAR GMAIL AVEC AUTHENT
robert c'est ce code ???????????????? il sert a quoi

ps robert j'ai une bonne nouvelle pour toi la version 2017 est casi fini et le must en javascript

**gpoth** · 23/02/2017, 23h24

oui, c'est résolu, mon problème venait du paramétrage de gmail.
du coup, j'ai pris mon FAI, c'était plus simple...

en revanche, l'affichage des images sur Courrier ne fonctionne pas, uniquement sur Outlook et gmail...
pour les input text, ca ne fonctionne que sur Gmail...

si vous avez une solution pour ceci, je prends...

merci beaucoup de votre aide.

Invité · 23/02/2017, 23h24

Bonsoir Patrick,
Je beta testerai avec plaisir

**gpoth** · 24/02/2017, 20h29

Bonjour,

les images ne peuvent être vus sur toutes les boites emails (en plus, ca fait une croix rouge moche!)
sinon, tout est ok...

si vous avez une solution à me fournir, je suis preneur...
cette fois, ca dépasse mes capacités..

idem pour les input sur html j'ai du abandonner (ca ne fonctionne qu'avec Gmail)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
 
Private Sub CommandButton101_Click()
 
totalcontact = 1
Do While (Sheets("contact").Range("A" & totalcontact) <> "")
totalcontact = totalcontact + 1
Loop
totalcontact = totalcontact - 1
 
 
' barr de progession
 
    Application.ScreenUpdating = False
    progression = 0
 
 
nbcontact = 1
 
Do
nbcontact = nbcontact + 1
labelprogession = Round(nbcontact / totalcontact * 100, 0)
progression = 200 * labelprogession / 100
prenom = Sheets("contact").Range("A" & nbcontact).Value
Nom = Sheets("contact").Range("B" & nbcontact).Value
Adresse = Sheets("contact").Range("C" & nbcontact).Value
 
 
                Image_barre.Width = progression
                Label_barre.Caption = labelprogession & "%"
                DoEvents
 
 
        Application.ScreenUpdating = True
       'enléve les messages d'alerte
        Application.DisplayAlerts = False
        'remet les messages d'alerte
        Application.DisplayAlerts = True
        'réactive le rafraichissement de l'écran
        Application.ScreenUpdating = True
 
 
 
Dim iMsg As Object, iConf As Object, Flds As Object
Set iMsg = CreateObject("cdo.message")
Set iConf = CreateObject("cdo.configuration")
 
Set Flds = iConf.Fields
With Flds ' pour Gmail
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Sheets("serveur").Range("A2").Value
            .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") = Sheets("serveur").Range("B2").Value
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Sheets("serveur").Range("C2").Value
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587   'stmp server port changer le numero si necessaire
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False   'Use SSL for the connection (False or True)
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 
    .Update
End With
 
 
With iMsg
    Set .Configuration = iConf
 
        .From = Sheets("serveur").Range("B2").Value ' Mon Adresse email
        .To = Adresse
        .Subject = "HMTL BODY du " & Date
 
 
Const SAUTLIGNE = "<br/>"
 
 
    img1 = "1-4.jpg"
    img2 = "2-4.jpg"
    img3 = "3-4.jpg"
    img4 = "4-4.jpg"
 
 
        .AddRelatedBodyPart ThisWorkbook.Path & "\" & "1-4.jpg", img1, 1
        .AddRelatedBodyPart ThisWorkbook.Path & "\" & "2-4.jpg", img2, 1
        .AddRelatedBodyPart ThisWorkbook.Path & "\" & "3-4.jpg", img3, 1
        .AddRelatedBodyPart ThisWorkbook.Path & "\" & "4-4.jpg", img4, 1
 
 
' on ecrit le mail
.HTMLBody = "<html><body>"
'.HTMLBody = .HTMLBody & "<form action=""mailto:guillaumepothier@hotmail.com"" method=""GET"">"
.HTMLBody = .HTMLBody & "<font face=""calibri"" size =""40"" color=""black""> hello <b>Bonjour ! " & prenom & " " & Nom & "</b></font>"
 
.HTMLBody = .HTMLBody & SAUTLIGNE & SAUTLIGNE
 
.HTMLBody = .HTMLBody & SAUTLIGNE & SAUTLIGNE
.HTMLBody = .HTMLBody & "<div align=""center""><table>"
 
.HTMLBody = .HTMLBody & "<tr>"
.HTMLBody = .HTMLBody & "<td><img src=""2-4.jpg""></td>"  'Ligne 1 - cols 1
.HTMLBody = .HTMLBody & "<td colspan=3><h3>Afin de mieux vous connaitre, de mesurer la satisfaction nos clients pour toujours mieux adapter la prestation de service et à évaluer l'importance accordée par le client à chacune de ces composantes.</h3></td>" 'Ligne 1 - cols 2à4
.HTMLBody = .HTMLBody & "</tr>"
 
 
 
.HTMLBody = .HTMLBody & "<tr>"
.HTMLBody = .HTMLBody & "<td><img src=""1-4.jpg""></td>"  'Ligne 1 - cols 1
.HTMLBody = .HTMLBody & "<td><h1>Participez à notre enquête de satisfaction !</h1></td>" 'Ligne 1 - cols 2
.HTMLBody = .HTMLBody & "<td colspan=2><img src=""3-4.jpg""></td>"   '  Ligne 1 - cols 3 & 4
.HTMLBody = .HTMLBody & "</tr>"
 
 
.HTMLBody = .HTMLBody & "<td><img src=""4-4.jpg""></td>"  'Ligne 1 - cols 1
.HTMLBody = .HTMLBody & "<td colspan=3><h4><a href=""http://localhost/satisfaction.php"">Cliquez ici pour participer</a></h4></td>" 'Ligne 1 - cols 2à4
.HTMLBody = .HTMLBody & "</tr>"
 
.HTMLBody = .HTMLBody & "</table></div>"
.HTMLBody = .HTMLBody & "</form></body></html>"
 
 
 
        '.Display
        '.Save
        .Send 'envoi automatique
 
End With
 
 
 
 
Loop Until (nbcontact = totalcontact)
 
 
 
End Sub

**patricktoulon** · 24/02/2017, 20h36

c'est normal tu update pas le fields pour tes images tu risque pas de les voirs

**gpoth** · 24/02/2017, 20h40

un .update juste après mes attachments et c'est suffisant ?

Merci.

Guillaume.

**patricktoulon** · 24/02/2017, 20h41

il faut le faire a chaque fois pour chaque image

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
set img=iMsg.AddRelatedBodyPart ThisWorkbook.Path & "\" & "1-4.jpg", img1, 1:img.Fields.Update
set img=iMsg.AddRelatedBodyPart ThisWorkbook.Path & "\" & "2-4.jpg", img2, 1:img.Fields.Update
set img=iMsg.AddRelatedBodyPart ThisWorkbook.Path & "\" & "3-4.jpg", img3, 1:img.Fields.Update
set img=iMsg.AddRelatedBodyPart ThisWorkbook.Path & "\" & "4-4.jpg", img4, 1:img.Fields.Update

voila

non pas en dernier avec tes attachements

je te l'ai déjà dis a ne pas confondre les body part et les attachement

c'est plus clair la??????

quand tu va au super maché faire tes commisions avec ton pagnier
tu met du lait,du pain,une salade, un steak,3tomates etc......

mais si tu passe pas a la caisse tu sortira sans miammiam
compare le field.uppdate au truc qui fait beepbepp a la caisse

**gpoth** · 24/02/2017, 20h50

dommage.
du coup, je l'ai écrit comme ca... sur "Courrier", les images ne s'affichent toujours pas...
dommage

merci quand même, tu m'as été d'une grande aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
.AddRelatedBodyPart ThisWorkbook.Path & "\" & "1-4.jpg", img1, 1
.Fields.Update
.AddRelatedBodyPart ThisWorkbook.Path & "\" & "2-4.jpg", img2, 1
.Fields.Update
.AddRelatedBodyPart ThisWorkbook.Path & "\" & "3-4.jpg", img3, 1
.Fields.Update
.AddRelatedBodyPart ThisWorkbook.Path & "\" & "4-4.jpg", img4, 1
.Fields.Update

**Oliv-** · 27/02/2017, 17h24

Salut Patrick,

Avec Outlook cela fonctionne aussi et les images sont a leur place !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub testgui()
    Set OL = CreateObject("Outlook.Application")
    Set oMail = OL.CreateItem(olMailItem)    '0
 
    'enléve les messages d'alerte
    Application.DisplayAlerts = False
    'remet les messages d'alerte
    Application.DisplayAlerts = True
    'réactive le rafraichissement de l'écran
    Application.ScreenUpdating = True
 
 
    Adresse = "toto@gmail.com"    'pour exemple
 
    With oMail
        .To = Adresse
        .BodyFormat = olFormatHTML
        .Subject = "HMTL BODY du " & Date
 
        ' debut du message html
        Const SAUTLIGNE = "<br/>"
 
        '
        .HTMLBody = "<body>"
 
        img1 = "1-4.jpg"
        img2 = "2-4.jpg"
        img3 = "3-4.jpg"
        img4 = "4-4.jpg"
 
        .Attachments.Add ThisWorkbook.path & "\" & "1-4.jpg", olByValue, 0
        .Attachments.Add ThisWorkbook.path & "\" & "2-4.jpg", olByValue, 0
        .Attachments.Add ThisWorkbook.path & "\" & "3-4.jpg", olByValue, 0
        .Attachments.Add ThisWorkbook.path & "\" & "4-4.jpg", olByValue, 0
 
 
 
        'Ecrit bonjour en gras, calibri, taille 40
        .HTMLBody = .HTMLBody & "<font face=""calibri"" size =""40"" color=""black""> hello <b>Bonjour ! " & prenom & " " & Nom & "</b></font>"
        'Saute deux lignes
        .HTMLBody = .HTMLBody & SAUTLIGNE & SAUTLIGNE
        'Ecrit le reste de l'entete
 
        .HTMLBody = .HTMLBody & SAUTLIGNE & SAUTLIGNE
        .HTMLBody = .HTMLBody & "<div align='center'><table>"
        .HTMLBody = .HTMLBody & "<tr>"
        .HTMLBody = .HTMLBody & "<td valign='middle'><b>test : <input type='text'>Ligne 1 - cols 1</input></b></td>"
        .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img1 & "'>"
        .HTMLBody = .HTMLBody & "Ligne 1 - cols 2</b></td>"
        .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img2 & "'>"
        .HTMLBody = .HTMLBody & "Ligne 1 - cols 3</b></td>"
        .HTMLBody = .HTMLBody & "</tr>"
 
        .HTMLBody = .HTMLBody & "<tr>"
        .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img3 & "'>"
        .HTMLBody = .HTMLBody & "Ligne 2 - cols 1</b></td>"
        .HTMLBody = .HTMLBody & "<td valign='middle'><b><img src='" & img4 & "'>"
        .HTMLBody = .HTMLBody & "Ligne 2 - cols 2</b></td>"
        .HTMLBody = .HTMLBody & "<td valign='middle'><b>Ligne 2 - cols 3</b></td>"
        .HTMLBody = .HTMLBody & "</tr>"
 
        .HTMLBody = .HTMLBody & "</table></div>"
 
        .HTMLBody = .HTMLBody & "</body>"
 
        .Display
        DoEvents
        .Send
    End With
End Sub

Par contre il y a des limites dans l'utilisation des formulaires pour obtenir une réponse, liées notamment à la sécurité

**gpoth** · 06/03/2017, 00h43

allez, on fait la pub...
remarque j'ai pris hostinger comme hébergeur gratuit...
j'ai un fichier d'email d'environ 3000 personnes

et là j'envoie avec smtp.sfr.... et là je plante à environ 50 mais envoyés...

Nom : erreur.png
Affichages : 312
Taille : 6,6 Ko

Nom : erreur.png
Affichages : 312
Taille : 6,6 Ko

dommage, j'y ai bien cru quelques courts instants...

que me conseillez vous comme serveur smtp ?

Merci.
Guillaume.

afficher image avec .htmlbody en vba hors outlook

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager