VBscript ZIP Dateien in jedem Ordner mit Dateien aus dem root füllen

Option Explicit

' Aufruf der Routine  
' Konstanten definieren  
Const srcDir = "D:\705000"  
Const destDir = "D:\705000"  
Const OverWriteFiles = "true"  

' Variablen Definieren  
Dim log, Logfile, ErrorLog, ErrorFile, FSO

' Log Files öffnen  
Set FSO = CreateObject("Scripting.FileSystemObject")  
Set LogFile = FSO.OpenTextFile("C:\" & Date & ".log",8,true)  
Set ErrorFile = FSO.OpenTextFile("C:\" & Date & "_errors.log",8,true)  

log = ""  
AddLog vbCrLf & "Archivierte Daten am " & Date() & " um " & time() & vbCrLf & vbCrLf  
Errorlog = ""  

ZIP srcDir, destDir, 3
kopieren srcDir, destDir, 3

LogFile.Writeline(log)
ErrorFile.Writeline(ErrorLog)


Private Sub Addlog(logLine)
	log = log & logLine & CHR(13)
End Sub

Private Sub AddErrorlog(logLine)
	errorlog = errorlog & logLine & CHR(13)
End Sub


private Sub ZIP(srcDir, destDir, tiefe)

	' Deklaration der Variablen  
	Dim FSO, Verzeichnis, UnterVerzeichnis
	
	' Objekt erzeugen  
	Set FSO = CreateObject("Scripting.FileSystemObject")  
	
	' Referenz auf SourceOrdner  
	Set Verzeichnis = FSO.GetFolder(srcDir)
	
	Dim ts, BlankZIP, x, Folder, File

	' Leere ZIP Datei erstellen, wenn keine Vorhanden in Source Ordner  
	If not FSO.FileExists("test.zip") then  
		Set ts = FSO.OpenTextFile(srcDir & "\" & "test.zip", 8, vbtrue)  
		BlankZip = "PK" & Chr(5) & Chr(6)  
		For x = 0 to 17
		BlankZip = BlankZip & Chr(0)
		ts.Write BlankZip
		Next
	End if
	
	' Alle Unterverzeichnisse auflisten  
	For Each UnterVerzeichnis in Verzeichnis.Subfolders
			ZIP UnterVerzeichnis, UnterVerzeichnis, 3
	Next
End Sub


private Sub kopieren(srcDir, destDir, tiefe)

	' Deklaration der Variablen  
	Dim FSO, Verzeichnis, UnterVerzeichnis
	
	' Objekt erzeugen  
	Set FSO = CreateObject("Scripting.FileSystemObject")  
	
	'  Wenn das Verzeichnis existiert  
	If FSO.FolderExists(srcDir) and (tiefe = 3) then
		AddLog srcDir & " -> " & destDir & "\" & "test.zip"  
	End if
	Addlog(" " & vbCrLF)  
	
	' Referenz auf SourceOrdner  
	Set Verzeichnis = FSO.GetFolder(srcDir)
	
	Dim Datei
	For Each Datei in Verzeichnis.Files
		FSO.CopyFile srcDir & "\" & Datei.Name, destDir & "\" & "test.zip"  
		if Err.Number <> 0 then
			AddErrorLog(Now() & ": Fehler beim Kopieren von: " & Datei.Name & " - Pfad: " & Datei.Path & " - Größe: " & FormatNumber(Datei.Size/1024,2,,,True) & " KB" & vbCrLf)  
			AddErrorLog("Grund: " & Err.Description & vbCrLf)  
			Err.Clear
		End if
	Next
	
	' Alle Unterverzeichnisse auflisten  
	For Each UnterVerzeichnis in Verzeichnis.Subfolders
			kopieren UnterVerzeichnis, UnterVerzeichnis, 3
	Next
End Sub
Errorfile.Close
Logfile.Close