'*** v10.B *** 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 = WScript.CreateObject("WScript.Network").ComputerName Dim Text : Text = "" Dim Anhang : Anhang = "" ' kein Anhang' Dim WSHNet : Set WSHNet = WScript.CreateObject("WScript.Network") Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell") Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim Args : Set Args = Wscript.Arguments Dim LogDatei : LogDatei = LogDateiFestlegenX64() ' Prozedur-Aufruf Trace32Log "037 :: ", 1 Trace32Log "038 :: Start " & WScript.ScriptFullName & " ( Dateidatum: " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1 Trace32Log "039 :: LogDatei: " & LogDatei, 1 Trace32Log "040 :: PCname: " & WSHNet.ComputerName, 1 Trace32Log "041 :: Angemeldeter User: " & WSHNet.UserName, 1 For i = 0 to Args.Count - 1 ' hole alle Argumente Text = Text & " " & Trim( Args( i ) ) Next Trace32Log "046 :: Erhaltenes Argument: '" & Text & "'", 1 EmailSenden SMTPServer, EmailFrom, EmailTo, UserName, UserPwd, Betreff, Text, Anhang ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ WScript.CreateObject("WScript.Shell").Popup "EMail versendet an " & vbCRLF & vbCRLF & vbTab & EmailTo, 7, "051 :: " & 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, , "090 :: " & WScript.ScriptName End Sub ' EmailSenden( SMTPServer, EmailVon, EmailAn, AnmName, AnmPassw, Betreff, Text, Anhang ) '************************************************************ Function LogDateiFestlegenX64() '************************************************************ Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim Txt, Tst Txt = WScript.FullName ' ergibt C:\WINDOWS\system32\wscript.exe Txt = Mid( Txt, 1, InStrRev( Txt, "\" ) - 1 ) ' ergibt C:\WINDOWS\system32 Tst = Mid( Txt, 1, InStrRev( Txt, "\" ) - 1 ) & "\SysWOW64" ' ergibt C:\WINDOWS\SysWOW64 If fso.FolderExists( Tst ) Then Txt = Tst ' : MsgBox Txt & vbCRLF & Tst, , "106 :: " Txt = Txt & "\CCM" ' ergibt C:\WINDOWS\sysWOW64\CCM\ oder C:\WINDOWS\system32\CCM\ If not fso.FolderExists( Txt ) Then fso.CreateFolder( Txt ) Txt = Txt & "\Inst.Log" ' ergibt C:\WINDOWS\sysWOW64\CCM\Inst.Log\ oder C:\WINDOWS\system32\CCM\Inst.Log\ If not fso.FolderExists( Txt ) Then fso.CreateFolder( Txt ) Txt = Txt & "\" & WScript.ScriptName ' ergibt ..\CCM\Inst.Log\....vbs" Txt = Mid( Txt, 1, InStrRev( Txt, "." ) ) ' ergibt ..\CCM\Inst.Log\...." Txt = Txt & "log" ' ergibt ..\CCM\Inst.Log\....log" LogDateiFestlegenX64 = Txt End Function ' LogDateiFestlegenX64() '*** v9.C *** www.dieseyer.de ****************************** Sub Trace32Log( LogTxt, ErrType ) '*********************************************************** ' in VBS und HTA verwendbar ' Aufbau einer LOG-Datei für trace32.exe ( SMS Trace; ' ALLES in einer Zeile!): ' ' < ' time="08:12:54.309+-60" ' date="03-14-2008" ' component="SrcUpdateMgr" ' context="" ' type="0" ' thread="1812" ' file="productpackage.cpp:97" ' > ' ' "context=" Info wird nicht angezeigt ' type="0" normale Zeie => NEUE LOG-DATEI - ggf. alte überschreiben !!!!!!!!!!!! ' type="1" normale Zeie ' type="2" gelbe Zeie ' type="3" rote Zeie ' type="F" rote Zeie ' "thread=" kann eine Dezimalzahl aufnehmen; trace32 zeigt ' neben der Dezimalzahl in Klammern die entspr. ' Hexadezimalzahl an - z.B. "33 (0x21)" ' "file=" wird in "Source:" angezeigt ' Dim fso : Set fso = CreateObject("Scripting.FileSystemObject") Dim LogDateiX, TitelX, Tst, Nr On Error Resume Next Tst = KeineLog On Error Goto 0 If UCase( Tst ) = "JA" Then Exit Sub On Error Resume Next TitelX = Titel ' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde TitelX = title ' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde If Len( TitelX ) < 2 Then TitelX = document.title ' .hta If Len( TitelX ) < 2 Then TitelX = WScript.ScriptName ' .vbs On Error Goto 0 On Error Resume Next LogDateiX = LogDatei ' wurde die Variable 'LogDatei' nicht außerhalb der Prozedur definiert If Len( LogDateiX ) < 2 Then LogDateiX = WScript.ScriptFullName & ".log" ' .vbs If Len( LogDateiX ) < 2 Then LogDateiX = TitelX & ".log" ' .hta On Error Goto 0 Nr = 0 ' Wenn in Thread die Zeilennummer stehen soll: Nr = 999999 If Nr = 0 AND InStr( LogTxt, " :" & ": " ) > 0 Then ' Wenn in Thread die Zeilennummer stehen soll - Voraussetzung ' ist eine ZeilenNr. im Format '22 :: ' Nr = LogTxt Nr = Mid( Nr, 1, InStrRev( Nr, " :" & ": " ) -1 ) ' nach der Zeilennummer Nr = Mid( Nr, InStrRev( Nr, " " ) + 1 ) ' vor der Zeilennummer On Error Resume Next : Tst = Int( Nr ) : On Error Goto 0 ' Zeilennummer als (Integer) Zahl Do ' Tst für Vergleich auf gleiche Länge wie Nr anpassen If Len( Tst ) = Len( Nr ) Then Exit Do Tst = "0" & Tst Loop If "x" & Tst = "x" & Nr Then LogTxt = Replace( LogTxt, Tst & " :" & ": ", "" ) Nr = Int( Nr ) End If End If If Nr = 999999 Then Nr = 0 ' Zwei Nachkommastellen (nach Sekunden) der aktuellen Zeit ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tst = Timer() ' timer() in USA: 1234.22 Tst = Replace( Tst, "," , ".") ' timer() in Deutschland: 123454,12 If InStr( Tst, "." ) = 0 Then Tst = Tst & ".000" Tst = Mid( Tst, InStr( Tst, "." ), 4 ) If Len( Tst ) < 3 Then Tst = Tst & "0" ' Zeitzone ermitteln - neu (v9.C) und immer richtig(er) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Dim AktDMTF : Set AktDMTF = CreateObject("WbemScripting.SWbemDateTime") AktDMTF.SetVarDate Now(), True : Tst = Tst & Mid( AktDMTF, 22 ) ' : MsgBox Tst, , "203 :: " ' MsgBox "AktDMTF: '" & AktDMTF & "'", , "204 :: " Set AktDMTF = nothing LogTxt = "" LogTxt = LogTxt & "<" LogTxt = LogTxt & "time=""" & Hour( Time() ) & ":" & Minute( Time() ) & ":" & Second( Time() ) & Tst & """ " LogTxt = LogTxt & "date=""" & Month( Date() ) & "-" & Day( Date() ) & "-" & Year( Date() ) & """ " LogTxt = LogTxt & "component=""" & TitelX & """ " LogTxt = LogTxt & "context="""" " LogTxt = LogTxt & "type=""" & ErrType & """ " LogTxt = LogTxt & "thread=""" & Nr & """ " LogTxt = LogTxt & "file=""dieseyer.de"" " LogTxt = LogTxt & ">" Tst = 8 ' LOG-Datei erweitern If ErrType = 0 Then Tst = 2 ' LOG-Datei erneuern (alte löschen, neue erstellen) On Error Resume Next If LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt ) If not LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt ) On Error Goto 0 Set fso = Nothing End Sub ' Trace32Log( LogTxt, ErrType )