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
Bitte um eure Hilfe
LG Christoph
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
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 130883
Url: https://administrator.de/contentid/130883
Ausgedruckt am: 26.11.2024 um 08:11 Uhr