'*** v15.2 *** 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 ' '*********************************************************** ' Jetzt mit SSL ' ggf. Port frei geben; vergl. https://hilfe.gmx.net/sicherheit/ssl.html ' netsh firewall add portopening protocol=TCP port=587 name="SMTTLS" mode=ENABLE scope=ALL ' Windows-FireWall zum Test ein- bzw. ausschalten: ' netsh firewall set opmode mode=enable profile=all ' netsh firewall set opmode mode=disable profile=all 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.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True 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 )