Auswahl = "Ordner auswählen und im selben Ordner befindet sich die gezippte Datei" 
StartOrdner = "C:\" 
Set Auswahl = CreateObject("Shell.Application").BrowseForFolder(0,Auswahl,16,Ordner) 
If TypeName(Auswahl) = "Nothing" Then 
    MsgBox "Abbruch" 
    WScript.Quit 

Else 
    Set Ordnerpfad = Auswahl.Self 

    End If

Dim src
Dim dest
src = Ordnerpfad.path
dest = Ordnerpfad.path & ".zip" 

'write zip file header 
Set fso = createobject("Scripting.FileSystemObject") 
Set file = fso.OpenTextFile(dest, 2, True)
file.write "PK" & chr(5) & chr(6) & string(18,chr(0)) 
file.close 

Set shl = createobject("Shell.Application") 
shl.namespace(dest).copyhere shl.namespace(src).items 
Do until shl.namespace(dest).items.count = shl.namespace(src).items.count 
wscript.sleep 100 
Loop