'*** v9.A *** www.dieseyer.de ****************************** ' File: Datensicherung.vbs ' Autor: dieseyer@gmx.de ' dieseyer.de ' ' Gemäß der Verzeichnisliste "Datensicherung.txt" wird auf ' dem ZielLaufwerk (1. zeile in "Datensicherung.txt") eine ' komprimierte Datei (Verzeichnis) mit dem Tagesdatum ' erstellt, in der alle Dateien der Verzeichnisse mit ' Unterverzeichnissen, wie in "Datensicherung.txt" gelistet, ' enthalten sind. ' Zeilen, die mit einem Leerschrit, einem Semikolon oder ' einem Apostroph beginnen werden ignoriert. '************************************************************ Option Explicit Dim fso, WSHShell, WSHNetzWerk, WSHLaufWerk, oArgs Dim i, FileOut, FileOut1, FileIn, TXT, TXT1, Text, ZielOK, VerzOK, Problem, Menge, Pwd Dim Zeit, ZielVerz, VerzListe, VerzNr Dim Prog_PP, FSO_PP, FileOut_PP, VBSDatei_PP Set Prog_PP = nothing Set WSHShell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") set oArgs = Wscript.Arguments Pwd = "" ' Passwort definieren ' => nächste Zeile frei geben '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ PwdAbfrage ' Function Aufruf LogDatei ( vbCRLF & now() & " - " & UCase(WScript.ScriptName) & " gestartet"& vbCRLF & "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ " ) ' Prüfen, ob VerzListe-Datei existiert; ' wenn nicht: anlegen und ausfüllen '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' VerzListe = "Datensicherung.txt" VerzListe = fso.GetBaseName( WScript.ScriptName ) & ".txt" if not fso.FileExists( VerzListe ) then Set FileOut = fso.OpenTextFile( VerzListe, 2, true) ' Datei zum Erweitern öffnen (notfals anlegen) Set FileIn = FSO.OpenTextFile( WScript.ScriptName, 1 ) ' Datei zum Lesen öffnen Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen TXT = FileIn.Readline ' eine Zeile lesen If not Left ( TXT, 1 ) = "'" then Exit Do FileOut.WriteLine( TXT ) Loop FileOut.WriteLine( "' Bitte jetzt vervollständigen:" ) FileOut.WriteLine( "' 1. freie Zeile: Ziel-Verzeichnis für Datensicherung" ) FileOut.WriteLine( "' 2. freie Zeile: zu sicherndes Quell-Verzeichnis für Datensicherung" ) FileOut.WriteLine( "' ?. freie Zeile: zu sicherndes Quell-Verzeichnis für Datensicherung" ) Set FileIn = nothing Set FileOut = nothing WSHShell.run VerzListe, 4, True End If ' Prüfen, ob VerzListe korrekt ist '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - ermittelt das Zielverzeichnis der Datensicherungen ' - Datensicherung.tmp enthält Liste der zu sichernden Verzichnisse ParameterAbfrage ' Function Aufruf ' Im Zielverzeichnis wird DatumVerzeichnis mit lfd. Nr. erzeugt '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ZielVerz = Datumverzeichnis ( ZielVerz ) ' Function Aufruf Set FileIn = fso.OpenTextFile( fso.GetBaseName( VerzListe ) & ".tmp", 1 ) ' Datei zum Lesen öffnen Menge = 0 Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen TXT = CStr( FileIn.Readline ) ' eine Zeile lesen if Len( TXT ) < 8 Then Text = TXT & vbTab if not Len( TXT ) < 8 Then Text = TXT if not fso.FolderExists( TXT ) then LogDatei ( vbCRLF & "!!! " & TXT & " nicht vorhanden. ") Else ' Menge = Menge + CLng(fso.GetFolder( TXT ).size) Menge = Menge + fso.GetFolder( TXT ).size Text = Text & vbTab & FormatNumber( fso.GetFolder( TXT ).size/1024 , 1) & " kByte" & vbTab & " zu sichern" Text = Text & vbTab & fso.getDrive( Left ( TXT, 2 ) ).VolumeName Text = Text & vbTab & fso.getDrive( Left ( TXT, 2 ) ).ShareName LogDatei ( Text ) Text = Replace( Left ( TXT, 1) & "" & Mid ( TXT, 3) , "\" , "²") '_______________________________________________________________ 'Für die Verwendung von XCOPY folgende beiden Zeilen frei geben ' Text = "xcopy """ & TXT & "\*.*"" """ & ZielVerz & "\" & Text & "\*.*"" /S/E/V " '_______________________________________________________________ 'Für die Verwendung von ROBOCOPY folgende Zeile frei geben ' Text = "robocopy """ & TXT & """ """ & ZielVerz & "\" & Text & """ /S /E /sec /w:1 /r:1 /log:" & ZielVerz & "\" & Text & ".log " '_______________________________________________________________ 'Für die Verwendung von RAR zwei Zeilen frei geben ' If Pwd = "" Then Text = "rar.exe a -ad -m5 -ap" & " -sfx """ & ZielVerz & "\" & Text & """ """ & TXT & """" ' If not Pwd = "" Then Text = "rar.exe a -ad -m5 -ap -hp" & Pwd & " -sfx """ & ZielVerz & "\" & Text & """.rar """ & TXT & """" TXT1 = "" If fso.FileExists( "7z.sfx" ) Then TXT1 = " -sfx7z.sfx" '_______________________________________________________________ 'Für die Verwendung von 7-Zip zwei Zeilen frei geben If Pwd = "" Then Text = "7z.exe a" & TXT1 & " -r" & " """ & ZielVerz & "\" & Text & ".exe"" """ & TXT & """" If not Pwd = "" Then Text = "7z.exe a" & TXT1 & " -r -p" & Pwd & " """ & ZielVerz & "\" & Text & ".exe"" """ & TXT & """" ' MsgBox text, , "115 :: " : WSCript.Quit '_______________________________________________________________ 'Wahlweise die RunBat oder WSHShell.Run Zeile frei geben ' RunBat ( Text ) ' Function Aufruf WSHShell.run "%comspec% /k " & Text , , True ' WSHShell.run Text , 8, True ' Passwort für LogDatei entfernen Text = Replace( Text, Pwd, "~-_Pwd_-~" ) LogDatei Text & vbTab & " . . . abgeschlossen. " & vbCRLF End If Loop LogDatei ( now() & " - " & UCase(WScript.ScriptName) & " beendet" ) LogDatei ( FormatNumber( Menge/1024, 1) & " kByte wurden in " & FormatNumber( fso.GetFolder( ZielVerz ).size/1024 , 1) & " kByte gepackt und nach " & ZielVerz & " gesichert. ") Set FileIn = nothing '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' LogDatei anzeigen (und an das Ende springen) ' => nächste Zeile frei geben ' LogDateiAnzeige '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Erstelltes Zielverzeichnis mit gesicherten Daten anzeigen ' => nächste Zeile frei geben WSHShell.run ZielVerz, 1 WScript.Quit ' ************************************************************** Function CopyNachA (Datei) ' Anfang ' ************************************************************** ' Archiv nach A: kopieren? Dim TXT, Text Dim WSHShell, fso Set WSHShell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") TXT = Datei If not fso.GetFile( Datei ).Size < 1457664-2048 then Text = Datei & vbCRLF & "ist mit " & Int( fso.GetFile( Datei ).Size/1024/1024 ) & " MB zu groß für eine Diskette!" WshShell.Popup Text, 10, WScript.ScriptName, 4096 Exit Function End If Text = "Soll das erstellte Archiv " & vbCRLF & vbCRLF Text = Text & LCase( Datei ) & " (" & FormatNumber( fso.GetFile( Datei ).Size,1) & " Byte)" & vbCRLF & vbCRLF Text = Text & "auf eine Diskette in A: kopiert werden? [N] nach 10 Sekunden." If not vbYes = WshShell.Popup( Text, 25, WScript.ScriptName, 4096+4+32) Then Exit Function '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Diskette bereit? If not fso.GetDrive( "a:" ).IsReady Then WshShell.Popup "Laufwerk A: ist nicht bereit!", 10, WScript.ScriptName, 4096 If not fso.GetDrive( "a:" ).IsReady Then Exit Function If fso.FileExists ( "A:\" & fso.GetBaseName( Datei ) & ".exe" ) then fso.DeleteFile "A:\" & fso.GetBaseName( Datei ) & ".exe", true '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Diskette mit genügend freien Speicher? If not fso.GetFile( Datei ).Size < fso.GetDrive( "a:" ).FreeSpace-1024 then Text = "Auf der Diskette in A: ist nicht genügend Platz!" & vbCRLF Text = Text & "Soll die Diskette formatiert werden?" If vbYes = WshShell.Popup( Text, 25, WScript.ScriptName, 4096+4+32) Then WSHShell.Run "format a: /F:1440 /Q /V:DISK1440", , True ' WSHShell.Run "%comspec% /k format a: /F:1440 /U /V:DISK1440", , True End If End If If not fso.GetFile( Datei ).Size < fso.GetDrive( "a:" ).FreeSpace-1024 then Exit Function PopsUp Datei & vbCRLF & vbCRLF & "wird z.Z. nach A: kopiert . . .", 90 fso.CopyFile Datei , "A:\" & fso.GetBaseName( Datei ) & ".exe" PopsUp "", 0 ' If fso.FileExists( "A:\" & fso.GetBaseName( Datei ) & ".exe" ) then ' PopsUp "A:\" & fso.GetBaseName( Datei ) & ".exe" & vbCRLF & vbCRLF & "wurde erstellt.!", 10 ' End If End Function ' CopyNachA (Datei) ' ************************************************************** ' ************************************************************** Function ParameterAbfrage ' ************************************************************** ' VerzeichnisListe zeilenweise lesen und prüfen i = 0 Problem = "" ZielOK = "" VerzOK = "" VerzNr = 0 Text = "" Set FileOut = fso.OpenTextFile( fso.GetBaseName( VerzListe) & ".tmp", 2, true) ' Datei zum Erweitern öffnen (notfals anlegen) Set FileIn = FSO.OpenTextFile( VerzListe, 1 ) ' Datei zum Lesen öffnen Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen TXT = FileIn.Readline ' eine Zeile lesen ' Bemerkungszeilen nicht prüfen '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If not Left ( TXT, 1 ) = ";" AND not Left ( TXT, 1 ) = " " AND not Left ( TXT, 1 ) = "'" then ' wenn die Zeile nicht mit . . . beginnt ZielOK = "ok" i = i + Len(TXT) +2 If not fso.FolderExists( TXT ) Then ZielOK = "fehlt" If VerzNr < 1 then FileOut.WriteLine( TXT ) If not VerzNr < 1 then FileOut.WriteLine( ";###" & ZielOk & " " & TXT ) Problem = "ja" Else FileOut.WriteLine( TXT ) End If ' Zeilen für MsgBox in Text sammeln; erste Zeile enthält ZielVerzeichnis '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If Text = "" Then ZielVerz = TXT VerzOK = ZielOK Text = "Nach " & ZielVerz & " (" & ZielOK & ") werden folgende Verzeichnisse gesichert (kopiert): " & vbTab & vbCRLF ' Zeilen für MsgBox in Text sammeln; jede weitere Zeile enthält zu sichernde Verzeichnisse '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Else VerzNr = VerzNr +1 if i < 400 then Text = Text & vbCRLF & VerzNr & vbTab & ZielOK & vbTab & " " & TXT End If End If Else FileOut.WriteLine( TXT ) End If Loop Set FileIn = nothing Set FileOut = nothing Text = Text & vbCRLF & " " & VerzNr & " Verzeichnisse insgesamt." ' Problem = "nEIn" If UCase( left(Problem,2) ) = "JA" Then Text = Text & vbCRLF & vbCRLF & "Die obigen Parameter sollten angepasst werden, da nicht alle Verzeichnisse " & vbCRLF & "vorhanden sind." Else Text = Text & vbCRLF & vbCRLF & "Die obigen Parameter sind soweit ok, können aber angepasst werden." End If If not UCase(Left( VerzOK, 2)) = "OK" Then ' Meldung, wenn ZielVerzeichnis nicht vorhanden Text = Text & vbCRLF & vbCRLF & UCase("Das Zielverzeichnis " & ZielVerz & " zur Datensicherung existiert nicht!") End If Text = Text & vbCRLF & vbCRLF & "Parameter korrigieren oder Skript abbrechen? [No] in 10sec." TXT = WshShell.Popup(Text, 5, WScript.ScriptName, 4096+3+32) If TXT = -1 AND not UCase(Left( VerzOK, 2)) = "OK" Then ' Meldung, wenn ZielVerzeichnis nicht vorhanden ' wenn keine Taste gedrückt wurde Text = UCase("Das Zielverzeichnis " & ZielVerz & " zur Datensicherung existiert nicht!") Text = Text & vbCRLF & vbCRLF & UCase("Das Skript wird ohne Datensicherung beendet!") LogDatei ( Text ) ' Sub Aufruf WshShell.Popup Text, 10, WScript.ScriptName, 64+4096 LogDateiAnzeige ' Sub Aufruf WScript.Quit End If If TXT = vbNo AND not UCase(Left( VerzOK, 2)) = "OK" Then ' Meldung, wenn ZielVerzeichnis nicht vorhanden MsgBox UCase("Das Zielverzeichnis " & ZielVerz & " zur Datensicherung existiert nicht!"), 4096+64, WScript.ScriptName ParameterAbfrage ' Function Aufruf End If If TXT = vbYes then fso.CopyFile fso.GetBaseName( VerzListe) & ".tmp", VerzListe WSHShell.run VerzListe, , True ParameterAbfrage ' Function Aufruf End If If TXT = vbCancel then WshShell.Popup " . . . denn eben nicht!", 10, WScript.ScriptName, 64+4096 Text = UCase("Das Skript wurde abgebrochen = keine Datensicherung!") LogDatei ( Text ) ' Sub Aufruf LogDateiAnzeige ' Sub Aufruf WScript.Quit End If i = 0 Set FileOut = fso.OpenTextFile( fso.GetBaseName( VerzListe) & ".tmp", 2, true) ' Datei zum Erweitern öffnen (notfals anlegen) Set FileIn = FSO.OpenTextFile( VerzListe, 1 ) ' Datei zum Lesen öffnen Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen TXT = FileIn.Readline ' eine Zeile lesen If not Left ( TXT, 1 ) = ";" AND not Left ( TXT, 1 ) = " " AND not Left ( TXT, 1 ) = "'" then ' wenn die Zeile nicht mit . . . beginnt If i > 0 then FileOut.WriteLine( TXT ) i = i +1 End If Loop Set FileIn = nothing Set FileOut = nothing End Function ' ParameterAbfrage ' ************************************************************** ' ************************************************************** Function Datumverzeichnis ( ZielVerz ) ' ************************************************************** ' legt im ZielVerzeichhnis ein Datumverzeichnis mit lfd. ' Nummer an: (k:\siceherer\)02-12-03_0 Zeit = now() ' zweistellige Jahreszahl Datumverzeichnis = Right(Year(Zeit),2) ' zweistellige Monatszahl If Len(Month(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "-0" & Month(Zeit) If not Len(Month(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "-" & Month(Zeit) ' zweistellige Tageszahl If Len(Day(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "-0" & Day(Zeit) If not Len(Day(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "-" & Day(Zeit) ' zweistellige Stundezahl ' If Len(Hour(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "_0" & Hour(Zeit) ' If not Len(Hour(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "_" & Hour(Zeit) ' zweistellige Minutenzahl ' If Len(Minute(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "'0" & Minute(Zeit) ' If not Len(Minute(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "'0" & Minute(Zeit) ' zweistellige Sekundenzahl ' If Len(Second(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "'0" & Second(Zeit) ' If not Len(Second(Zeit)) = 1 then Datumverzeichnis = Datumverzeichnis & "'" & Second(Zeit) ' if not fso.FolderExists( ZielVerz & "\" & Datumverzeichnis ) then ' fso.CreateFolder( ZielVerz & "\" & Datumverzeichnis ) ' Exit Function ' End If for i = 0 to 99 If i < 1 then i = "0" If i < 10 then i = "0" & CStr(i) ' zweistellig machen If not i < 10 then i = "" & CStr(i) ' zweistellig lassen if not fso.FolderExists( ZielVerz & "\" & Datumverzeichnis & "." & i ) then Datumverzeichnis = ZielVerz & "\" & Datumverzeichnis & "." & i fso.CreateFolder( Datumverzeichnis ) Exit Function End If next End Function ' Datumverzeichnis ( ZielVerz ) ' ************************************************************** ' ************************************************************** Function RunBat ( BatTXT ) ' ************************************************************** ' erzeugt eine .BAT Datei mit 2x Pause und führt diese aus ' MsgBox BatTXT TXT1 = "bsp.bat" Set FileOut1 = fso.OpenTextFile( TXT1 , 2, true) ' Datei zum Erweitern öffnen (notfals anlegen) FileOut1.WriteLine( "@echo off") FileOut1.WriteLine( "@echo " & BatTXT ) FileOut1.WriteLine( "@" & BatTXT ) FileOut1.WriteLine( "@pause") FileOut1.WriteLine( "@pause") Set FileOut1 = nothing WSHShell.run "%comspec% /c " & TXT1 , , True End Function ' RunBat ( BatTXT ) ' ************************************************************** ' ************************************************************** Sub LogDatei (LogTxt) ' ************************************************************** Dim FileOut, fso Set fso = WScript.CreateObject("Scripting.FileSystemObject") Set FileOut = fso.OpenTextFile( fso.GetBaseName( WScript.ScriptName ) & ".log", 8, true) ' fileOut.WriteLine (vbCRLF & Now() ) fileOut.WriteLine (LogTxt) Set FileOut = Nothing End Sub ' LogDatei ' ************************************************************** ' ************************************************************** Sub PwdAbfrage ' ************************************************************** For i = 0 to oArgs.Count - 1 ' hole alle Argumente Pwd = oArgs.item(i) Exit For ' ein Argument reicht Next Text = "Die Dateien der Datensicherung werden " & vbCRLF & vbCRLF & UCase("mit einem Passwort geschützt.") Text = Text & vbCRLF & vbCRLF & "Ist das so gewollt? in 15sec." ' If not Pwd = "" then TXT = WshShell.Popup( Text, 15, WScript.ScriptName, 4096+4+32) Text = "Die Dateien der Datensicherung werden " & vbCRLF & vbCRLF & UCase("nicht mit einem Passwort geschützt.") Text = Text & vbCRLF & vbCRLF & "Ist das so gewollt? in 15sec." If Pwd = "" then TXT = WshShell.Popup( Text, 15, WScript.ScriptName, 4096+4+32) Text = "Mit welchen Passwort sollen die Dateien der Datensicherung geschützt werden?" Text = Text & vbCRLF & "Das Passwort darf ! KEINE ! Leerzeichen enthalten!" If TXT = vbNo then Pwd = InputBox (Text, WScript.ScriptName) End Sub ' PwdAbfrage ' ************************************************************** ' ************************************************************** Sub LogDateiAnzeige ' ************************************************************** Dim FileOut, fso Set fso = WScript.CreateObject("Scripting.FileSystemObject") WSHShell.run "notepad " & fso.GetBaseName( WScript.ScriptName ) & ".log" On Error Resume Next WScript.Sleep 500 WSHShell.SendKeys "^{End}" ' ans Ende springen WScript.Sleep 500 WSHShell.SendKeys "{Up}" ' eine Zeile hoch WScript.Sleep 500 WSHShell.SendKeys "+{Down}" ' mit gedrückter Shift-Taste eine Zeile nach unten ' markiert die letzte Zeile ' WScript.Sleep 20000 ' WSHShell.SendKeys "%{F4}" ' schließt das aktuelle Fenster On Error GoTo 0 WScript.Quit End Sub ' LogDateiAnzeige ' ************************************************************** ' ************************************************************** Function PopsUp ( TxT, Dauer ) ' Aufruf v3.7 - http://dieseyer.de ' ************************************************************** ' ACHTUNG! Ausserhalb und ver dem ersten Aufruf dieser Prozedur ' muss einmal "Set Prog_PP = nothing" stehen, sonst wird es ' mit dem "prog.terminate" innerhalb der Prozedur nichts! ' ' ACHTUNG! Alle Variablen müssen ausserhalb dieser Prozedur ' deklariert werden (also folgende Zeilen an den Skript-Anafng): ' Dim Prog_PP, FSO_PP, FileOut_PP, VBSDatei_PP ' Set Prog_PP = nothing ' ' Die Vorversion hat (versucht) das PopUp über AppActivate ' zu schließen. Set Fso_PP = CreateObject("Scripting.FileSystemObject") ' VBSDatei_PP = WSHShell.ExpandEnvironmentStrings("%Temp%") & "\" & Fso_PP.GetBaseName( WScript.ScriptName ) & "-MSG.VBS" VBSDatei_PP = WScript.CreateObject("WScript.Shell").ExpandEnvironmentStrings("%Temp%") & "\" & Fso_PP.GetBaseName( WScript.ScriptName ) & "-MSG.VBS" On Error Resume Next Prog_PP.terminate ' If not err.Number = 0 then MsgBox err.Description On Error GoTo 0 If Txt = "" then ' On Error Resume Next IF Fso_PP.FileExists(VBSDatei_PP) then Fso_PP.DeleteFile(VBSDatei_PP) ' löscht das MSG-VBScript ' On Error GoTo 0 Exit Function End If Txt = Replace( Txt, vbCRLF, """ & vbCRLF & """ ) Set FileOut_PP = Fso_PP.OpenTextFile(VBSDatei_PP, 2, true) ' MSG-VBScript öffnen mit neu anlegen FileOut_PP.WriteLine "WScript.CreateObject(""WScript.Shell"").Popup """ & Txt & """ , " & Dauer & ", """ & Fso_PP.GetFileName( VBSDatei_PP ) & " "" " FileOut_PP.Close Set FileOut_PP = Nothing Set Prog_PP = createObject("WScript.Shell").exec( "WScript " & VBSDatei_PP ) Set Fso_PP = Nothing End Function ' PopsUp v3.7 - http://dieseyer.de ' **************************************************************