Envoie mail, VBS et HTA

**Marion33** · 03/07/2017, 20h06

Bonsoir,

Je souhaiterais, à partir de mon script VBS d’envoi de mail, créer une application HTML (HTA) qui m'édite certaines données du script (identifiants par exemple) sous la forme d'un espace texte afin que je puisse rentrer moi même les informations. Ainsi qu'un bouton envoyer à l'envoie du mail. Voici mon script:

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
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
 
<HTML>
	<HEAD>
	<TITLE>Post-it HTA</TITLE>
	<HTA:APPLICATION ID="postit"
		APPLICATIONNAME="hta-post-it"
		SINGLEINSTANCE="Yes"
		VERSION="1.0"
		ICON="notepad.exe"
		MAXIMIZEBUTTON="No"
		SHOWINTASKBAR="No"
		SCROLL="No">
	>
	</HEAD>
<SCRIPT TYPE="text/Vbscript">
Const cdoSendUsingPickup = 1 
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
Const cdoBasic = 1
Const cdoNTLM = 2
 
Set objMessages = CreateObject("CDO.Message") 
objMessages.Subject = monsujet
objMessages.From = "monadresse@yahoo.com"
objMessages.To = "sonadresse@yahoo.com"
sBody = test
objMessages.HTMLBody = sBody
objMessages.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
 
objMessages.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.yahoo.com"
 
objMessages.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
 
objMessages.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "monadresse@yahoo.com"
 
objMessages.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "monmdp"
 
objMessages.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
 
objMessages.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
 
objMessages.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 2000
 
objMessages.Configuration.Fields.Update
objMessages.Send
 
If Err.Number <> 0 Then			
Else
End If
On Error GoTo 0
</SCRIPT>
	<body>
	</Body>
</HTML>

j'aimerais avoir:

Ligne 24, un champs champs texte pour remplir objMessages.From =

Ligne 25, un champs champs texte pour remplir objMessages.To =

Ligne 49/50, un menu déroulant pour choisir mon délai moi même parmi quelques autres pour remplir

objMessages.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") =

Ligne 53, un bouton pour déclencher l'envoi.

J'aimerais me lancer dans le HTA mais je nage un peu.. après certains exemple je pourrai me débrouiller seule..
Je vous remercie pour votre aide,
Marion.

Invité · 03/07/2017, 20h13

Bonjour

As-tu lu ceci : https://vb.developpez.com/telecharge...c-piece-jointe

Philippe

**Marion33** · 03/07/2017, 21h07

Oui je viens de voir, je vous remercie. Cependant, ce n'est pas réellement ce que je recherche, j'ai pris l'envoie de mail en exemple mais j'aurais pu prendre autre chose. En fait j'aimerais surtout comprendre comment à partir de mon script, donc du VBS seulement, remplacer des données par des champs à remplir sur le HTA, éventuellement un menu déroulant pour certaines valeurs, et bien sur le bouton envoyer.

Je ne sais pas si cela est possible car après quelques recherches je n'ai vraiment pas trouvé ce que je cherchais ..

**hackoofr** · 06/07/2017, 02h49

Inspirez-vous de cet exemple en HTA

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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
<html> 
<head> 
<HTA:APPLICATION 
    ICON="icon.ico"
    APPLICATIONNAME = "SMTP Mail Client" 
    BORDER="dialog"
    BORDERSTYLE="complex"
    CONTEXTMENU="no"
    SYSMENU="yes"
    MAXIMIZEBUTTON="no"
    SCROLL="no" 
>
<title>SMTP Mail Client © Hackoo</title> 
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> 
<style>
    body{
        background-color: lightblue;
    }
    label,.btn{
        font-weight: bold;
    }
</style>
<script language="VBScript">
Const cdoSendUsingPickup = 1 
Const cdoSendUsingPort = 2 'Must use this to use Delivery Notification
Const cdoAnonymous = 0
Const cdoBasic = 1 ' clear text
Const cdoNTLM = 2 'NTLM
'Delivery Status Notifications
Const cdoDSNDefault = 0 'None
Const cdoDSNNever = 1 'None
Const cdoDSNFailure = 2 'Failure
Const cdoDSNSuccess = 4 'Success
Const cdoDSNDelay = 8 'Delay
Const cdoDSNSuccessFailOrDelay = 14 'Success, failure or delay
messageSSLHTML = "<center><font size=4 FACE=Comic sans MS style=font-weight:bold Color=red Color=red>Ceci est un exemple de message en HTML.<br>Il a été envoyé en utilisant l'authentification SMTP et SSL.<br><br>"
Signature = "<center><font size=10 FACE=Comic sans MS style=font-weight:bold Color=red><br>©<br><img src=http://photomaniak.com/upload/out.php/i1102064_IDNlogo.gif>" 
 
 
 
Sub ViaGmail
'Formater le textaera au format html pour contourner le problème du message qui s'affiche sur une seule ligne
'Un Grand Merci à patrick pour cette Astuce
Dim st,i,tb,f1,paragraphe
st=txtbody.value
tb = split(st,vbcrlf)
For i = lbound(tb) to ubound(tb)
  paragraphe=paragraphe & tb(i) & "<br>" & vbcrlf
Next
 
f1 = file.Value
Login = InputBox ("Donner Votre adresse email  !", "ADRESSE GMAIL DU EXPEDITEUR", "moi@gmail.com") 
Password = InputBox ("Donner Votre Mot de passe email  !", "VOTRE MOT DE PASSE GMAIL", "")
GmailBox=MsgBox ("Envoi avec ces Options:" & vbCrLf &"Expéditeur :"& Login & vbCrLf & "Destinataire : "& txtTo.Value &  vbCrLf & "Sujet :" & txtSubject.Value & vbCrLf & "FileAttach1 :"& f1 ,vbYesNo+64,"Message Options")
    If GmailBox = vbYes Then 
    if  SendGmailSSL(Login,Password, txtTo.Value, txtSubject.Value, paragraphe+messageSSLHTML+Signature,f1)= 0  Then
 
    MsgBox "Le Mail a été envoyé avec succès !",vbInformation ,"Information"
    Else
 
    MsgBox "Echec d'envoi du Mail !",vbExclamation ,"Information"
    End If
    End If
End Sub
 
Function SendGmailSSL( sFrom, sPassword, sTO ,sSubject, sBody, sFilePath1)
 
 
    Set objMessage = CreateObject("CDO.Message") 
    objMessage.Subject = sSubject 
    objMessage.From = sFrom
    objMessage.To = sTO
 
    objMessage.HTMLBody = sBody 
    If sFilePath1 <> "" Then
        objMessage.AddAttachment sFilePath1   
    End If
 
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = sFrom
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sPassword
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    objMessage.Configuration.Fields.Update
 
    On Error Resume Next
    objMessage.Send
    SendGmailSSL = Err.Number
    If Err.Number <> 0  Then
        MsgBox Err.Description, 16, "SendGmailSSL Erreur"
    End If
 
End Function
 
 
    Sub window_onload()
        CenterWindow 415, 600
    End Sub
 
    Sub CenterWindow(x,y)
        window.resizeTo x, y
        iLeft = window.screen.availWidth/2 - x/2
        itop = window.screen.availHeight/2 - y/2
        window.moveTo ileft, itop
    End Sub
 
Sub SendMail()
'Formater le textaera au format html 
Dim st,i,tb,paragraphe
st=txtbody.value
tb = split(st,vbcrlf)
For i = lbound(tb) to ubound(tb)
  paragraphe=paragraphe & tb(i) & "<br>" & vbcrlf
Next
  SendMailMessage txtFrom.Value, txtTo.Value, txtSubject.Value, paragraphe ,txtSMTPSERVER.Value, file.Value      
    End Sub
 
    Sub SendMailMessage( sFrom, sTo, sSubject, sBody, SMTPSERVER, File)
        MsgBox "Envoi du Mail avec ces options:"& vbCrLf &"Expéditeur: "& sFrom & vbCrLf & "To: " & sTo & vbCrLf &"Sujet: " & sSubject & vbCrLf &"Text Message: " & sBody & vbCrLf & "SMTP SERVER: " & SMTPSERVER & vbCrLf & "Piéce-jointe: " & File,64,"Send Email"
        messageHTML="<center><font size=4 FACE=Comic sans MS style=font-weight:bold Color=red>Ceci est un exemple de message avec Signature en HTML <br> envoyé par Hackoo !" 
        File = document.getElementById("file").Value 
 
        Set msg = CreateObject("CDO.Message") 
        With msg
            .From = sFrom
            .To = sTo 
            .Subject = sSubject
            .TextBody = sBody 
            .HTMLBody=sBody & messageHTML & Signature 
            .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
            .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPSERVER 
            .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
            If File <> "" Then
               .AddAttachment File  'Ajout de la piéce-jointe
            End If  
            .Configuration.Fields.Update 
            On Error Resume Next
            .Send
            If Err.Number <>0 Then 
                MsgBox Err.Description,16,"Error Sending Mail"
            Else 
                MsgBox "Le Mail a été envoyé avec succès !",64,"Information" 
            End If
 
        End With
 
    End Sub
</script> 
</head> 
 
<body> 
 
    <label for="Expéditeur" style="width: 120; textalign: right;">Expéditeur:</label><input type="text" id="txtFrom" name="Expéditeur" value="Expéditeur@gmail.com"><br /> 
    <label for="to" style="width: 120; textalign: right;">Destinataire:</label><input type="text" id="txtTo" name="to" value="Destinataire@gmail.com"><br />
    <label for="subject" style="width: 120; textalign: right;">Sujet:</label><input type="text" id="txtSubject" name="sujet" value="Sujet"><br />
    <label for="txtSMTPSERVER" style="width: 120; textalign: right;">SMTP:</label><input type="text" id="txtSMTPSERVER" name="txtSMTPSERVER" value="smtp.orange.fr"><br />
    <label for="file">Pièce-Jointe :</label><br />
    <input type="file" name="file" id="file" /><br>
    <label>Message:</label><br />
    <textarea id="txtBody" rows="20" cols="45"></textarea><br><br>
    <center>
    <input class="btn" type="button" value="Envoyer Via Gmail" onClick="ViaGmail">
    <input class="btn" type="button" value="Envoyer Via SMTP" onClick="SendMail">
</body> 
</html>

**Marion33** · 06/07/2017, 18h24

merci beaucoup je vais regarder et m'inspirer de ton code !

**Marion33** · 06/07/2017, 19h49

J'ai réussi à créer le bouton envoyer !!!

Cependant je n'arrive pas à entrer une valeur telle que mon mail (ligne 27) et mon mot de passe (ligne 28)

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
<HTML>
	<HEAD>
	<TITLE>Envoie Mail</TITLE>
	<HTA:APPLICATION ID="postit"
		APPLICATIONNAME="Envoie Mail"
		SINGLEINSTANCE="Yes"
		ICON="chrome.exe"
		MAXIMIZEBUTTON="No"
		SHOWINTASKBAR="No"
		SCROLL="No">
	>
	</HEAD>
<SCRIPT TYPE="text/Vbscript">
On error resume next
 
Set oShell = CreateObject("WScript.Shell")
 
Dim mConfig
Dim mChps
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.mail.yahoo.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "monmail@yahoo.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "monmdp"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 2000
.Update 
End With
 
On error resume next
Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
Const cdoBasic = 1
Const cdoNTLM = 2
 
Set objMessages = CreateObject("CDO.Message")
objMessages.Subject = "Test"
objMessages.From = "monmail@yahoo.com"
objMessages.To = "monmail@yahoo.com"
sBody = strHomeFolder
objMessages.HTMLBody = sBody
objMessages.Configuration = mConfig
 
Sub envoyer ()
 
objMessages.Send 
 
end sub
 
</SCRIPT>
	<body>
 
<input class="btn" type="button" value="Envoyer" onClick="envoyer">
 
	</Body>
</HTML>

Est ce que tu pourrais me montrer juste pour cet exemple ? car je n'ai pas vraiment compris sur l'autre code.. J'imagine que la solution doit être simple mais ça fais plus de 1h que je cherche et je n'y arrive pas !!

**ProgElecT** · 06/07/2017, 20h23

Salut

Ajouter ligne 58

Code :

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

Saisir votre le sendusername: <INPUT TYPE="text" NAME="TxtSendusername" SIZE="20" MAXLENGTH="30" VALUE="????">

et la ligne 27 devient

Code :

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

.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = TxtSendusername.value

**Marion33** · 06/07/2017, 20h33

ça fonctionne merci !!!

**ProgElecT** · 06/07/2017, 21h05

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
<HTML>
	<HEAD>
	<TITLE>Envoie Mail</TITLE>
	<HTA:APPLICATION ID="postit"
		APPLICATIONNAME="Envoie Mail"
		SINGLEINSTANCE="Yes"
		ICON="chrome.exe"
		MAXIMIZEBUTTON="No"
		SHOWINTASKBAR="No"
		SCROLL="No">
	>
	</HEAD>
	<SCRIPT language="VBScript">
	Sub envoyer()
		msgbox "smtpconnectiontimeout" & vbnewline & LstTimeout(LstTimeout.selectedIndex).value
		msgbox "sendusername" & vbnewline & TxtSendusername.value
	End Sub
	</SCRIPT>
	<body>
	Saisir votre le sendusername: <INPUT TYPE="text" NAME="TxtSendusername" SIZE="20" MAXLENGTH="30" VALUE="????">
	<br>
	Saisir votre le smtpconnectiontimeout:
	<br>
	<SELECT NAME="LstTimeout" SIZE=4>
		<OPTION VALUE="1OO">100
		<OPTION VALUE="150">150
		<OPTION VALUE="200" SELECTED>200
		<OPTION VALUE="250" >250
		<OPTION VALUE="300" >300
	</SELECT>
	<br> <br>
	<input class="btn" type="button" value="Envoyer" onClick="envoyer">
	</Body>
</HTML>

Pour te permettre d'être plus autonome, visite cette page interface-HTA de bbil

**Marion33** · 06/07/2017, 21h42

Super merci !

Envoie mail, VBS et HTA

VBScript

Discussions similaires

Partager

Partager