'Comment envoyer un email en VBScript (SENDMAIL.VBS)
Option explicit
On error resume next
Const ProgVersion="3.0"
Dim WshArgs, WshNetwork
Dim iMsg, Flds, iConf
Dim i, j, sKey, sVal
Dim sFrom, sTo, sCC, sBCC, sSubject, sBody, sServer, iPort, sUserName, sPassword, sAttach()
Set WshArgs = WScript.Arguments
Set WshNetwork = WScript.CreateObject("WScript.Network")
'DEFAULT VALUES IF NONE GIVEN
sFrom = WshNetwork.ComputerName
sServer = "ROP-MES01"
iPort = 25
Rem AUTEUR: uiopuiop
Rem ------------------------------------------------------------------------
redim preserve sAttach(0)
for i=0 to WshArgs.Count - 1
GetVal WshArgs(i), sKey, sVal 'On split les arguments
wscript.echo "<" & sKey & "> = <" & sVal & ">"
Select case Ucase(sKey)
case "FROM": sFrom=sVal
case "TO": sTo=sVal
case "CC": sCC=sVal
case "BCC": sBCC=sVal
case "SUBJECT": sSubject=sVal
case "BODY": sBody=sVal
case "SERVER": sCC=sVal
case "PORT": iPort=sVal
case "USERNAME": sUserName=sVal
case "PASSWORD": sPassword=sVal
case "ATTACH"
j=uBound(sAttach):redim preserve sAttach(j+1)
sAttach(j)= sVal
' wscript.echo "Dim:" & j & " Attach:" & sAttach(j)
end select
next
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
' Set oRec = CreateObject("ADODB.Record")
' Set Conn = CreateObject("ADODB.Connection")
Flds("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Flds("http://schemas.microsoft.com/cdo/configuration/smtpserver") = sServer
Flds("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = iPort
Flds("http://schemas.microsoft.com/cdo/configuration/sendusername") = sUserName
Flds("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sPassword
Flds.Update
With iMsg
Set .Configuration = iConf
if uBound(sAttach)>0 then
for i=0 to uBound(sAttach) - 1
.AddAttachment sAttach(i)
next
end if
.From = sFrom
.To = sTo
.Cc = sCC
.bcc = sBcc
.Subject = sSubject
.TextBody = sBody
.Send
End With
if err.number <> 0 then
wscript.echo "ERREUR: [Number=" & err.number & "][Description=" & err.description & "]" & vbCrLf & vbCrLf & _
ShowSyntax()
else
wscript.echo "Mail sent successfully at " & Now
end if
wscript.quit
'Splitter une chaine en 2
Sub GetVal( sLigne, byRef sKey, byRef sVal)
Dim iPos
iPos=InStr(sLigne,"=")
if iPos>0 then
sKey=ucase(Left(sLigne,iPos-1))
if len(sLigne)>iPos then
sVal=Trim(Mid(sLigne,iPos+1,len(sLigne)-iPos))
else
sVal=""
end if
else
sKey=""
sVal=""
end if
' wscript.echo "Ligne:" & sLigne & " sKey=" & sKey & " sVal=" & sVal
end Sub
function ShowSyntax
Dim sOut
sOut = ""
sOut = sOut & "SYNTAXE: cscript " & wscript.Scriptname & " ARGUMENTS" & vbcrlf & vbCrLf
sOut = sOut & "From=<Email of sender>. Default is servername." & vbCrLf
sOut = sOut & "To=<Emails of recipients separated by ;>. The only mandatory parameter." & vbCrLf
sOut = sOut & "CC=<Emails of Carbon Copy separated by ;>" & vbCrLf
sOut = sOut & "BCC=<Emails of Blind Carbon Copy separated by ;>" & vbCrLf
sOut = sOut & "Subject=<Mail subject>" & vbCrLf
sOut = sOut & "Body=<Text body of email>" & vbCrLf
sOut = sOut & "Server=<Host name of SMTP server>. Default is " & sServer & "." & vbCrLf
sOut = sOut & "Port=<Port number of SMTP server>. Default is 25." & vbCrLf
sOut = sOut & "Username=<Username of non anonymous SMTP connection>" & vbCrLf
sOut = sOut & "Username=<Password of non anonymous SMTP connection>" & vbCrLf
sOut = sOut & "Attach=<Path of attachment>. Many attachments may be given" & vbCrLf & vbCrLf
sOut = sOut & "If arguments contain spaces, you must quote arguments" & vbCrLf
sOut = sOut & "cscript sendmail.vbs TO=user1@mycorp.com;
user2@yours.com " & chr(34) & "subject=Subject with spaces" & chr(34) & " Attach=c:\myfile1.txt " & chr(34) & "Attach=d:\my file2.txt" & chr(34) & vbCrLf
ShowSyntax = sOut
end function
