chrizz-at
Goto Top

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

Hallo liebes Forum,
ich habe ein Script erstellt welches Rekursiv in jedem Ordner eine ZIP Datei erstellt.

Ich möchte nun diese ZIP Dateien die in jedem Ordner liegen mit Dateien füllen..
Und zwar jene Dateien die im Root verzeichnis jedes ordners liegen..


Die ZIP Files werden schön angelegt nur beim 2. Teil unten funktioniert das nicht mit CopyFile..
-> Hier Zeile 86!

Gibt es eine andere Methode Dateien (ohne Ordnern) aus einem die in einem Ordner liegen zusammenzufassen und in die ZIP File zu schieben?

Ausserdem sollen die Rekursionen nur bis zu einer gewissen Ebene ausgeführt werden.
zb. bis D:\705000\test\test

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

Bitte um eure Hilfe
LG Christoph

Content-ID: 130883

Url: https://administrator.de/contentid/130883

Ausgedruckt am: 26.11.2024 um 08:11 Uhr