Dim username, Ag, ts, objShell, WshShell, DestFldr, SrcFldr, WScript, BlankZip, _
  objFolder
 
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
 
Set ts = FSO.OpenTextFile(speicherort & "\" & speicherordner & ".zip", 8, _
  vbTrue)
BlankZip = "PK" & Chr(5) & Chr(6)
For x = 0 To 17
BlankZip = BlankZip & Chr(0)
Next
 
ts.Write BlankZip
        Set objFolder = Nothing
        Set objShell = Nothing
Set FSO = Nothing
Set ts = Nothing
 
Set objShell = CreateObject("Shell.Application")
 
Set DestFldr = objShell.NameSpace(pfad2 & speicherordner & ".zip")
Set SrcFldr = objShell.NameSpace(pfad2 & speicherordner)
DestFldr.CopyHere (pfad2 & speicherordner)