Windows XP and 2003 Native Zip/Unzip

I've been doing a lot of this lately, so figured I'd post it.
 
This allows you to ZIP all the files in a folder into a zip file, using Windows XP's native Compressed Folders functionality.  It doesn't give as good compression rates as WinZIP or WinRAR, but it has the added benefit of working on every Windows XP and 2003 computer, with no extra software.
 

 Function fZip(sSourceFolder,sTargetZIPFile)
 'This function will add all of the files in a source folder to a ZIP file
 'using Windows' native folder ZIP capability.
 'Returns an integer 0 if everything went ok.
  Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription
  Set oShellApp = CreateObject("Shell.Application")
  Set oFSO = CreateObject("Scripting.FileSystemObject")
   'The source folder needs to have a \ on the End
   If Right(sSourceFolder,1) <> "\" Then sSourceFolder = sSourceFolder & "\"
  On Error Resume Next 
    'If a target ZIP exists already, delete it
    If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True 
   iErr = Err.Number
  On Error GoTo 0
   If iErr <> 0 Then   
    fZip = iErr
    Exit Function
   End If
  On Error Resume Next
   'Write the fileheader for a blank zipfile.
   oFSO.OpenTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
   iErr = Err.Number
  On Error GoTo 0
   If iErr <> 0 Then   
    fZip = iErr
    Exit Function
   End If
  On Error Resume Next 
   'Start copying files into the zip from the source folder.
   oShellApp.NameSpace(sTargetZIPFile).CopyHere oShellApp.NameSpace(sSourceFolder).Items
   iErr = Err.Number
  On Error GoTo 0
   If iErr <> 0 Then   
    fZip = iErr
    Exit Function
   End If
    'Because the copying occurs in a separate process, the script will just continue.  Run a DO...LOOP to prevent the function
    'from exiting until the file is finished zipping.
    Do Until oShellApp.NameSpace(sTargetZIPFile).Items.Count = oShellApp.NameSpace(sSourceFolder).Items.Count
     WScript.Sleep 500
    Loop
  fZip = 0
 End Function 
 

 
This allows you to UNZIP all the files from a zip file into a folder.
 

 Function fUnzip(sZipFile,sTargetFolder)
  'Create the Shell.Application object
  Dim oShellApp:Set oShellApp = CreateObject("Shell.Application")
  'Create the File System object
  Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
  'Create the target folder if it isn't already there
  If Not oFSO.FolderExists(sTargetFolder) Then oFSO.CreateFolder sTargetFolder
  'Extract the files from the zip into the folder
  oShellApp.NameSpace(sTargetFolder).CopyHere oShellApp.NameSpace(sZipFile).Items
   'This is a seperate process, so the script would continue even if the unzipping is not done
   'To prevent this, we run a DO...LOOP once a second checking to see if the number of files
   'in the target folder equals the number of files in the zipfile.  If so, we continue.
   Do
    WScript.Sleep 1000
   Loop While oFSO.GetFolder(sTargetFolder).Files.Count < oShellApp.NameSpace(sZipFile).Items.Count
 End Function
 

 

http://www.visualbasicscript.com/m_46632/tm.htm

Hokay, so I can't keep track of what I've posted and what I haven't. hehehehe
 
 
 
Sorry.

But hey, at least it isn't a 4 page advertisement for printers or cameras.

No worries man , I'm sure someone will still ask if zipping is possible with VBScript and say they can't find examples. 

I saw those advertisements, deleted them, and notified the poster.

There is a question:
if there is a folder that has nothing in it ,i use this code to zip to a ZipFile,and somithing wrong occurs.i can't zippes the folder that there  is a empty folder in it.

so how can i do??

PS:I am a chinese,and the System display a dialog that show me wrong in chinese,so i can't tell you the details that the WSH says.

I have tried this script which is very good and works.  I have also tried other similar scripts but.
 
I am trying to compress multiple folders to one zip file.
 
folder1 = C:\Folder1
folder2 = C:\Folder2
folder3 = C:\Documents and Settings\myuser\folder3
 
myzip = C:\Myzipfile.zip
 
WScript.Echo("Compressing Folder1")
fZip(folder1,myzip)
WScript.Echo("Compressing Folder2")
fZip(folder2,myzip)
 
This is where the script does not error nor does it work.  I have tried to do this multipe ways and same results it compresses the 1st folder then it just sits there.
 
I have tracked the problem down to this section of code in all the scripts I have tried.
 
zipcnt = oShellApp.NameSpace(myzip).Items.Count
newcnt = zipcnt + oShellApp.NameSpace(folder2).Items.Count
 
trying either of these lines causes the same thing it cannot read the items from the zip.  I have tried to do this manually also just read the items in a zip file and echo it out the same thing happens  Could you assist me or point me in the correct way of doing this. 
 
I need to copy the folder and all of its contents into the zip and do thise with multiple folders.

To answer the two quesitons:
 
1) Windows Xp Compressed Folders don't include empty folders.  But, as long as the empty folder is not int he root of the sourcefoler, you will be ok.
For example:
 
This won't work...
fZip "c:\dev", "c:\dev.zip"
with the following folder structure
c:\dev
c:\dev\folder1
c:\dev\This_is_an_empty_folder
 
But, this WILL work...
c:\dev
c:\dev\folder1
c:\dev\folder1\This_is_an_empty_folder
 
 
2) This script was written to just add the contents of a single folder to a single zip file.
I will look further into it, but just don't have the time right now.

because I could not get this to work on multiple folders into one zip at the moment I had to take the long way about doing this.

I copy all files and folders I want to zip into a new folder I create and then zip this folder up it seems to work as for compressing everything up. It does however take an extremely long time to copy all the information before compressing. The script then suddenly just exists once it is done, even though it is supposed to let the user know it is complete and the zip file exists and sleep for 5 seconds to display the information before quiting.

I appreciate your help and will also continue to look for a method to compress multiple folders into one zip.

Hi,
 
I was just wondering where and how would you define in the script the source folder and destination folder/file?
 
Thank you in advance,
 
Alpha

Um, it is a function that takes two arguments.
The arguments are named, oddly enough: sSourceFolder and sTargetZIPFile
 
I'm thinking that the argument sSourceFolder is probably the source folder and that sTargetZIPFile is most likely the destination zip file.
 
iResult = fZip("c:\myfolder", "c:\myzip.zip")
 
If iResult <> 0 then
     msgbox "There was an error"
end if
 
 
Also, the function is commented and documented so that you could read through it and find out the info.

ORIGINAL: raygn

because I could not get this to work on multiple folders into one zip at the moment I had to take the long way about doing this.

I copy all files and folders I want to zip into a new folder I create and then zip this folder up it seems to work as for compressing everything up. It does however take an extremely long time to copy all the information before compressing. The script then suddenly just exists once it is done, even though it is supposed to let the user know it is complete and the zip file exists and sleep for 5 seconds to display the information before quiting.

I appreciate your help and will also continue to look for a method to compress multiple folders into one zip.

 
There are limits as to what you can access via VBScript.  This is a method to utilize the built-in ZIP compression of Windows, via VBScript.  of course, there are going to be methods out there that will work and give greater functionality, speed, etc.  BUT, they wouldn't be native vbscript methods.  They are 3rd party utils.
 
If you are looking for something that is still not a packaged EXE, yet allows you to do this stuff via vbscript, you might consider paying a few hundred dollars for some of Chilkat's activeX objects.  I hear they are great.  Or, you could download and buy Winzip or WinRAR and call them from the commandline via vbscript.
 

Hi Digital.Skream,
 
Do you think you can please lend a hand? Trying to modify your script so that a file is zipped, but unfortunately I only able to get it to create a blank zip file.
 
Thanks in advance for your help!
 
Here's how call from cmd:  zipfile.vbs C:\Data\Projects\Zip\test.dat, C:\Data\Projects\Zip\Temp\test.zip

 
Here's the code:
 

' Initialize/Set the variables

Dim WshShell, strSourceFile, strZipFile, strYear, strMonth, strDay

Set WshShell = WScript.CreateObject("WScript.Shell")
'Source

strSourceFile = WScript.Arguments.Item(0)
'Target

strZipFile = WScript.Arguments.Item(1)
fZip strFile, strZipFile

Function fZip(strFileToZip,sTargetZIPFile)

'This function will add all of the files in a source folder to a ZIP file
'using Windows' native folder ZIP capability.

Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription

Set oShellApp = CreateObject("Shell.Application")

Set oFSO = CreateObject("Scripting.FileSystemObject")
'The source folder needs to have a \ on the End
' If Right(strFileToZip,1) <> "\" Then strFileToZip = strFileToZip & "\"

On Error Resume Next
'If a target ZIP exists already, delete it

If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description

On Error GoTo 0
If iErr <> 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function

End If



On Error Resume Next

'Write the fileheader for a blank zipfile.

oFSO.OpenTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description

On Error GoTo 0
If iErr <> 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function

End If
On Error Resume Next
'Start copying files into the zip from the source folder.
' oShellApp.NameSpace(sTargetZIPFile).CopyHere oShellApp.NameSpace(strFileToZip).Items
'Copy only one file

oShellApp.NameSpace(sTargetZIPFile).CopyHere strFileToZip
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description

On Error GoTo 0
If iErr <> 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function

End If


WScript.Sleep 500

'Because the copying occurs in a separate process, the script will just continue. Run a DO...LOOP to prevent the function

'from exiting until the file is finished zipping.

'Do Until oShellApp.NameSpace(sTargetZIPFile).Items.Count = oShellApp.NameSpace(strFileToZip).Items.Count

'WScript.Sleep 500

'Loop

fZip = Array(0,"","")

End Function

nvm Digital.Skream.
 
I found out what was wrong; it was the way it's being called from cmd. Omit the comma and it will work. Thanks!

Hi,

I am testing your code but I got a blank zip file. Do you have any idea?

zhtway

Hi Digital.Skream,

I just simply copy your code and run it. no error shown. but empty zip file.
I am testing on WindowsXP.

thanks
zhtway

hi.. i am trying to unzip .zip files with this code.. it is ok in my local machine win xp, but in win 2003 server it raises 

error '80070002' 
/client/asp/runproc.asp, line 37 

line 37--> oShellApp.NameSpace(sTargetFolder).CopyHere oShellApp.NameSpace(sZipFile).Items

tried to googling but no luck..

any help would be appreciated.. thanks..

I used the script to unzip. But after couple of runs, its throwing an error "Unable to copy"->file already exists, even though the destination folder has been deleted and then created again.
 
 
Please help.

I have been using this script code for 16 months with a call from a SQL Server Integration Services 'Execute Process Task'.  I send it the name of the Zipped file and where to unzip the contents.  this was on a Windows 2003 Server running SQL Server 2008.  Now my computer center is upgrading to Windows Server 2008 (only for TEST but they are ready to move to Production.)  The Script does not work corrctly from the same SSIS package running on Windows 2008 Server.  Any ideas?  I cannot convince my system admins to load the vjslib.dll  - they say they might forget it if they move to another server.
Thanks

vionixt


I used the script to unzip. But after couple of runs, its throwing an error "Unable to copy"->file already exists, even though the destination folder has been deleted and then created again. 
 

I had the same error ... go to your _user_tempfolder and delete all the temporary folders. everytime you unzip it creates a copy in the tempfolder and when you have 99 it will give you this error.
 

On Xp/2003, have you been able to use the options for CopyHere method?
such as (4) to suppres display of the progress dialog:
oShellApp.NameSpace(sTargetZIPFile).CopyHere oShellApp.NameSpace(sSourceFolder).Items, 4
 
I have found the options are ignored. Can't find a solution....