Rob van der Woude's Scripting Pages

VBScript Scripting Techniques > Files > ZIP Files

ZIP Files

  1. ZIP files and/or folders with X-ZIP
  2. ZIP folders with System.Shell Folders' CopyHere method
  3. UNZIP with X-ZIP
  4. UNZIP with System.Shell Folders' CopyHere method

 

ZIP files with X-ZIP
VBScript Code:
Zip "C:\boot.ini", "C:\testzip.zip"


Function Zip( myFileSpec, myZip )
' This function uses X-standards.com's X-zip component to add
' files to a ZIP file.
' If the ZIP file doesn't exist, it will be created on-the-fly.
' Compression level is set to maximum, only relative paths are
' stored.
'
' Arguments:
' myFileSpec    [string] the file(s) to be added, wildcards allowed
'                        (*.* will include subdirectories, thus
'                        making the function recursive)
' myZip         [string] the fully qualified path to the ZIP file
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
' The X-zip component is available at:
' http://www.xstandard.com/en/documentation/xzip/
' For more information on available functionality read:
' http://www.xstandard.com/printer-friendly.asp?id=C9891D8A-5390-44ED-BC60-2267ED6763A7
    Dim objZIP
    On Error Resume Next
    Err.Clear
    Set objZIP = CreateObject( "XStandard.Zip" )
    objZIP.Pack myFileSpec, myZip, , , 9
    Zip = Err.Number
    Err.Clear
    Set objZIP = Nothing
    On Error Goto 0
End Function
 
Requirements:
Windows version: any
Network: any
Client software: X-ZIP component
Script Engine: any
Summarized: Works in any Windows version with the X-ZIP component installed.
 
[Back to the top of this page]
 
ZIP folders with System.Shell Folder's CopyHere method
VBScript Code:
Option Explicit

Dim arrResult

arrResult = ZipFolder( "C:\Documents and Settings\MyUserID\Application Data", "C:\MyUserID.zip" )
If arrResult(0) = 0 Then
    If arrResult(1) = 1 Then
        WScript.Echo "Done; 1 empty subfolder was skipped."
    Else
        WScript.Echo "Done; " & arrResult(1) & " empty subfolders were skipped."
    End If
Else
    WScript.Echo "ERROR " & Join( arrResult, vbCrLf )
End If


Function ZipFolder( myFolder, myZipFile )
' This function recursively ZIPs an entire folder into a single ZIP file,
' using only Windows' built-in ("native") objects and methods.
'
' Last Modified:
' October 12, 2008
'
' Arguments:
' myFolder   [string]  the fully qualified path of the folder to be ZIPped
' myZipFile  [string]  the fully qualified path of the target ZIP file
'
' Return Code:
' An array with the error number at index 0, the source at index 1, and
' the description at index 2. If the error number equals 0, all went well
' and at index 1 the number of skipped empty subfolders can be found.
'
' Notes:
' [1] If the specified ZIP file exists, it will be overwritten
'     (NOT APPENDED) without notice!
' [2] Empty subfolders in the specified source folder will be skipped
'     without notice; lower level subfolders WILL be added, whether
'     empty or not.
' [3] There seems to be an undocumented limit to the number of files
'     that can be added, possibly due to timeouts; limits may vary from
'     200 to 700 files; better stay well below 200 files just to be safe.
' [4] ZIP files can NEVER exceed 2 GB! This is a limitation in the ZIP
'     format itself.
'
' Based on a VBA script (http://www.rondebruin.nl/win/s7/win001.htm)
' by Ron de Bruin, http://www.rondebruin.nl
'
' (Re)written by Rob van der Woude
' http://www.robvanderwoude.com

    ' Standard housekeeping
    Dim intSkipped, intSrcItems
    Dim objApp, objFolder, objFSO, objItem, objTxt
    Dim strSkipped

    Const ForWriting = 2

    intSkipped = 0

    ' Make sure the path ends with a backslash
    If Right( myFolder, 1 ) <> "\" Then
        myFolder = myFolder & "\"
    End If

    ' Use custom error handling
    On Error Resume Next

    ' Create an empty ZIP file
    Set objFSO = CreateObject( "Scripting.FileSystemObject" )
    Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )
    objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
    objTxt.Close
    Set objTxt = Nothing

    ' Abort on errors
    If Err Then
        ZipFolder = Array( Err.Number, Err.Source, Err.Description )
        Err.Clear
        On Error Goto 0
        Exit Function
    End If
    
    ' Create a Shell object
    Set objApp = CreateObject( "Shell.Application" )

    ' Copy the files to the compressed folder
    For Each objItem in objApp.NameSpace( myFolder ).Items
        If objItem.IsFolder Then
            ' Check if the subfolder is empty, and if
            ' so, skip it to prevent an error message
            Set objFolder = objFSO.GetFolder( objItem.Path )
            If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then
                intSkipped = intSkipped + 1
            Else
                objApp.NameSpace( myZipFile ).CopyHere objItem
            End If
        Else
            objApp.NameSpace( myZipFile ).CopyHere objItem
        End If
    Next

    Set objFolder = Nothing
    Set objFSO    = Nothing

    ' Abort on errors
    If Err Then
        ZipFolder = Array( Err.Number, Err.Source, Err.Description )
        Set objApp = Nothing
        Err.Clear
        On Error Goto 0
        Exit Function
    End If

    ' Keep script waiting until compression is done
    intSrcItems = objApp.NameSpace( myFolder  ).Items.Count
    Do Until objApp.NameSpace( myZipFile ).Items.Count + intSkipped = intSrcItems
        WScript.Sleep 200
    Loop
    Set objApp = Nothing

    ' Abort on errors
    If Err Then
        ZipFolder = Array( Err.Number, Err.Source, Err.Description )
        Err.Clear
        On Error Goto 0
        Exit Function
    End If

    ' Restore default error handling
    On Error Goto 0

    ' Return message if empty subfolders were skipped
    If intSkipped = 0 Then
        strSkipped = ""
    Else
        strSkipped = "skipped empty subfolders"
    End If

    ' Return code 0 (no error occurred)
    ZipFolder = Array( 0, intSkipped, strSkipped )
End Function
 
Requirements:
Windows version: Windows 2000, XP, Server 2003 & Vista
Network: any
Client software: N/A
Script Engine: any
Summarized: Should work in Windows 2000 and later.
Will not work in Windows 95, 98, ME or NT.
 
[Back to the top of this page]
 
UNZIP with X-ZIP
VBScript Code:
UnZip "C:\testzip.zip", "D:\", "*.ini"


Function UnZip( myZip, myTargetDir, myFileSpec )
' This function uses X-standards.com's X-zip component to extract files from a ZIP file.
'
' Arguments:
' myZip         [string] the fully qualified path to the ZIP file
' myTargetDir   [string] the directory where the extracted files will be located
' myFileSpec    [string] the file(s) to be extracted, wildcards allowed
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
' The X-zip component is available at:
' http://www.xstandard.com/en/documentation/xzip/
' For more information on available functionality read:
' http://www.xstandard.com/printer-friendly.asp?id=C9891D8A-5390-44ED-BC60-2267ED6763A7
    Dim objZIP
    On Error Resume Next
    Err.Clear
    Set objZIP = CreateObject( "XStandard.Zip" )
    objZIP.UnPack myZip, myTargetDir, myFileSpec
    UnZip = Err.Number
    Err.Clear
    Set objZIP = Nothing
    On Error Goto 0
End Function
 
Requirements:
Windows version: any
Network: any
Client software: X-ZIP component
Script Engine: any
Summarized: Works in any Windows version with the X-ZIP component installed.
 
[Back to the top of this page]
 
UNZIP with System.Shell Folder's CopyHere method

(can also be used to extract CAB files and other archives,
or to copy folders while displaying a progress bar)
VBScript Code:
Option Explicit

' UnZip "C:\test.zip" into the folder "C:\test1"
Extract "C:\test.zip", "C:\test1"

' Extract "C:\test.cab" into the folder "C:\test2"
Extract "C:\test.cab", "C:\test2"

' Copy the contents of folder "C:\test2" to the folder "C:\test3"
Extract "C:\test2", "C:\test3"


Sub Extract( ByVal myZipFile, ByVal myTargetDir )
' Function to extract all files from a compressed "folder"
' (ZIP, CAB, etc.) using the Shell Folders' CopyHere method
' (http://msdn2.microsoft.com/en-us/library/ms723207.aspx).
' All files and folders will be extracted from the ZIP file.
' A progress bar will be displayed, and the user will be
' prompted to confirm file overwrites if necessary.
'
' Note:
' This function can also be used to copy "normal" folders,
' if a progress bar and confirmation dialog(s) are required:
' just use a folder path for the "myZipFile" argument.
'
' Arguments:
' myZipFile    [string]  the fully qualified path of the ZIP file
' myTargetDir  [string]  the fully qualified path of the (existing) destination folder
'
' Based on an article by Gerald Gibson Jr.:
' http://www.codeproject.com/csharp/decompresswinshellapics.asp
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com

    Dim intOptions, objShell, objSource, objTarget

    ' Create the required Shell objects
    Set objShell = CreateObject( "Shell.Application" )

    ' Create a reference to the files and folders in the ZIP file
    Set objSource = objShell.NameSpace( myZipFile ).Items( )

    ' Create a reference to the target folder
    Set objTarget = objShell.NameSpace( myTargetDir )

    ' These are the available CopyHere options, according to MSDN
    ' (http://msdn2.microsoft.com/en-us/library/ms723207.aspx).
    ' On my test systems, however, the options were completely ignored.
    '      4: Do not display a progress dialog box.
    '      8: Give the file a new name in a move, copy, or rename
    '         operation if a file with the target name already exists.
    '     16: Click "Yes to All" in any dialog box that is displayed.
    '     64: Preserve undo information, if possible.
    '    128: Perform the operation on files only if a wildcard file
    '         name (*.*) is specified.
    '    256: Display a progress dialog box but do not show the file
    '         names.
    '    512: Do not confirm the creation of a new directory if the
    '         operation requires one to be created.
    '   1024: Do not display a user interface if an error occurs.
    '   4096: Only operate in the local directory.
    '         Don't operate recursively into subdirectories.
    '   8192: Do not copy connected files as a group.
    '         Only copy the specified files.
    intOptions = 256

    ' UnZIP the files
    objTarget.CopyHere objSource, intOptions

    ' Release the objects
    Set objSource = Nothing
    Set objTarget = Nothing
    Set objShell  = Nothing
End Sub
 
Requirements:
Windows version: Windows 2000, XP, Server 2003 & Vista
Network: any
Client software: N/A
Script Engine: any
Summarized: Should work in Windows 2000 and later.
Will not work in Windows 95, 98, ME or NT.
 
Save File As dialog (SAFRCFileDlg.FileSave)
 
[Back to the top of this page]

page last modified: 2016-09-19; loaded in 0.0023 seconds