windowsvbscriptbatch-filezipscripting

Can Windows' built-in ZIP compression be scripted?


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.


Solution

  • 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