Fileaze banner

 

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
    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.
'
' Arguments:
' myFolder   [string]  the (path and) name of the folder to be ZIPped
' myZipFile  [string]  the (path and) file name 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.
'
' Based on a VBA script (http://www.rondebruin.nl/windowsxpzip.htm)
' by Ron de Bruin, http://www.rondebruin.nl
'
' (Re)written by Rob van der Woude
' http://www.robvanderwoude.com

    ' Standard housekeeping
    Dim objApp, objFSO, objTxt
    Const ForWriting = 2

    ' 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
    Set objFSO = 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
    objApp.NameSpace( myZipFile ).CopyHere objApp.NameSpace( myFolder ).Items

    ' 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
    Do Until objApp.NameSpace( myZipFile ).Items.Count _
           = objApp.NameSpace( myFolder  ).Items.Count
        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 code 0 (no error occurred)
    ZipFolder = Array( 0, "", "" )
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 (path and) file name of the ZIP file
' myTargetDir  [string]  the 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.
    '   9182: 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]