'*** v9.A *** www.dieseyer.de ****************************** 

' 

' Datei:  emailsenden.vbs 

' Autor:  dieseyer@gmx.de 

' Auf:    www.dieseyer.de 

' 

' Siehe http://www.microsoft.com/technet/scriptcenter/resources/qanda/nov04/hey1129.mspx 

' How Can I Attach a File to an Email Sent Using CDO? 

' ==> The Scripting Guys Answer Your Questions 

' Dort fehlt 

'   ...Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")= 1 

' 

'*********************************************************** 

 

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl 

 

  Dim	EmailTo		: EmailTo	= "nichtverwendet@gmx.de" 

  Dim	EmailFrom	: EmailFrom	= EmailTo 

  Dim	UserName	: UserName	= EmailTo 

  Dim	UserPwd		: UserPwd	= "PwdIstGeheim!" 

  Dim	SMTPServer	: SMTPServer	= "smtp.1und1.de" 

			: SMTPServer	= "mail.gmx.net" 

  Dim	Betreff		: Betreff	= "Email per SMTP mit Login" 

  Dim	Text		: Text		= "Ich hoffe, das VBS packt das . . . von " & CreateObject("WScript.Network").ComputerName 

  Dim	Anhang		: Anhang	= WScript.ScriptFullName	' als Anhang dieses VBS 

			: Anhang	= ""				' kein Anhang' 

 

  EmailSenden SMTPServer, EmailFrom, EmailTo, UserName, UserPwd, Betreff, Text, Anhang 

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 

 

  WScript.CreateObject("WScript.Shell").Popup "EMail versendet an " & vbCRLF & vbCRLF & vbTab & EmailTo, 7, "31 :: " & WScript.ScriptName, vbInformation 

 

WScript.Quit  

 

'*** v9.A *** www.dieseyer.de ****************************** 

Sub EmailSenden( SMTPServer, EmailVon, EmailAn, AnmName, AnmPassw, Betreff, Text, Anhang ) 

'*********************************************************** 

' Siehe http://www.microsoft.com/technet/scriptcenter/guide/sas_ent_wbpa.mspx?mfr=true 

' Siehe http://www.microsoft.com/technet/scriptcenter/resources/qanda/nov04/hey1129.mspx 

' How Can I Attach a File to an Email Sent Using CDO? 

' ==> The Scripting Guys Answer Your Questions 

' Dort fehlt: 

'   .Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")= 1 

' Sonst kommt: 

'   550 must be authenticated 

'   550 Need to authenticate 

' Siehe http://msdn.microsoft.com/en-us/library/ms526318%28EXCHG.10%29.aspx 

  Dim Tst 

  Dim objEmail		: Set objEmail	= CreateObject("CDO.Message") 

  objEmail.From	= EmailVon 

  objEmail.To	= EmailAn 

' objEmail.Cc	= EmailAn 

' objEmail.Bcc	= EmailAn 

  objEmail.Subject	= Betreff 

  objEmail.Textbody	= Text 

  If not Anhang = "" Then 

  objEmail.AddAttachment Anhang 

  End If 

  objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")	= 2 

  objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")	= SMTPServer 

  objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport")	= 25 

  objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")= 1 

  objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername")	= AnmName 

  objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword")	= AnmPassw 

  objEmail.Configuration.Fields.Update 

  On Error Resume Next 

 

  Tst = objEmail.Send 

 

  If err.Number <> 0 Then MsgBox err.Number & " - " & err.Description, , "70 :: " & WScript.ScriptName 

 

End Sub ' EmailSenden( SMTPServer, EmailVon, EmailAn, AnmName, AnmPassw, Betreff, Text, Anhang )