sub createZip(sfolder, tfolder) dim fso, zipfile dim shell, WshShell, destfolder, srcfolder ' create a blank zip compress file set fso = CreateObject("Scripting.FileSystemObject") set zipfile = fso.OpenTextFile(tfolder, 8, vbtrue) zipfile.Write "PK" & Chr(5) & Chr(6) & string(18, 0) zipfile.close ' copy you file into blank zip file set shell = CreateObject("Shell.Application") set WshShell = WScript.CreateObject("WScript.Shell") set destfolder = shell.NameSpace(tfolder) set srcfolder = shell.NameSpace(sfolder) destfolder.CopyHere srcfolder.items, &H214