Question

Is the ZIP compression that is built into Windows XP/Vista/2003/2008 able to be scripted at all? What executable would I have to call from a BAT/CMD file? or is it possible to do it with VBScript?

I realize that this is possible using WinZip, 7-Zip and other external applications, but I’m looking for something that requires no external applications to be installed.

Answer 1

There are VBA methods to zip and unzip using the windows built in compression as well, which should give some insight as to how the system operates. You may be able to build these methods into a scripting language of your choice.

The basic principle is that within windows you can treat a zip file as a directory, and copy into and out of it. So to create a new zip file, you simply make a file with the extension .zip that has the right header for an empty zip file. Then you close it, and tell windows you want to copy files into it as though it were another directory.

Unzipping is easier – just treat it as a directory.

In case the web pages are lost again, here are a few of the relevant code snippets:

ZIP

Sub NewZip(sPath) 'Create empty Zip File 'Changed by keepITcool Dec-12-2005     If Len(Dir(sPath)) > 0 Then Kill sPath     Open sPath For Output As #1     Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)     Close #1 End Sub   Function bIsBookOpen(ByRef szBookName As String) As Boolean ' Rob Bovey     On Error Resume Next     bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing) End Function   Function Split97(sStr As Variant, sdelim As String) As Variant 'Tom Ogilvy     Split97 = Evaluate('{''' & _                        Application.Substitute(sStr, sdelim, ''',''') & '''}') End Function  Sub Zip_File_Or_Files()     Dim strDate As String, DefPath As String, sFName As String     Dim oApp As Object, iCtr As Long, I As Integer     Dim FName, vArr, FileNameZip      DefPath = Application.DefaultFilePath     If Right(DefPath, 1) <> '\' Then         DefPath = DefPath & '\'     End If      strDate = Format(Now, ' dd-mmm-yy h-mm-ss')     FileNameZip = DefPath & 'MyFilesZip ' & strDate & '.zip'      'Browse to the file(s), use the Ctrl key to select more files     FName = Application.GetOpenFilename(filefilter:='Excel Files (*.xl*), *.xl*', _                     MultiSelect:=True, Title:='Select the files you want to zip')     If IsArray(FName) = False Then         'do nothing     Else         'Create empty Zip File         NewZip (FileNameZip)         Set oApp = CreateObject('Shell.Application')         I = 0         For iCtr = LBound(FName) To UBound(FName)             vArr = Split97(FName(iCtr), '\')             sFName = vArr(UBound(vArr))             If bIsBookOpen(sFName) Then                 MsgBox 'You can't zip a file that is open!' & vbLf & _                        'Please close it and try again: ' & FName(iCtr)             Else                 'Copy the file to the compressed folder                 I = I + 1                 oApp.Namespace(FileNameZip).CopyHere FName(iCtr)                  'Keep script waiting until Compressing is done                 On Error Resume Next                 Do Until oApp.Namespace(FileNameZip).items.Count = I                     Application.Wait (Now + TimeValue('0:00:01'))                 Loop                 On Error GoTo 0             End If         Next iCtr          MsgBox 'You find the zipfile here: ' & FileNameZip     End If End Sub 

UNZIP

Sub Unzip1()     Dim FSO As Object     Dim oApp As Object     Dim Fname As Variant     Dim FileNameFolder As Variant     Dim DefPath As String     Dim strDate As String      Fname = Application.GetOpenFilename(filefilter:='Zip Files (*.zip), *.zip', _                                         MultiSelect:=False)     If Fname = False Then         'Do nothing     Else         'Root folder for the new folder.         'You can also use DefPath = 'C:\Users\Ron\test\'         DefPath = Application.DefaultFilePath         If Right(DefPath, 1) <> '\' Then             DefPath = DefPath & '\'         End If          'Create the folder name         strDate = Format(Now, ' dd-mm-yy h-mm-ss')         FileNameFolder = DefPath & 'MyUnzipFolder ' & strDate & '\'          'Make the normal folder in DefPath         MkDir FileNameFolder          'Extract the files into the newly created folder         Set oApp = CreateObject('Shell.Application')          oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items          'If you want to extract only one file you can use this:         'oApp.Namespace(FileNameFolder).CopyHere _          'oApp.Namespace(Fname).items.Item('test.txt')          MsgBox 'You find the files here: ' & FileNameFolder          On Error Resume Next         Set FSO = CreateObject('scripting.filesystemobject')         FSO.deletefolder Environ('Temp') & '\Temporary Directory*', True     End If End Sub