Zip a file programatically

422 views
Skip to first unread message

Red

unread,
Oct 8, 2004, 6:20:14 AM10/8/04
to
Help why doesn't this zip work it creates the .ZIP file but does not
copy the source to it?!??! No errors, I can drag files into the .zip
created with the script what gives?
Also tried different source and locations -thanks.
Option Explicit

Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oFileSys, oCTF

MySource = "C:\tmp"
MyZipName = "SinkFolder"

MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0)
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next

Set oShell = CreateObject("WScript.Shell")
MyTarget = "C:\temp\" & MyZipName & ".zip"

Set oFileSys = CreateObject("Scripting.FileSystemObject")
Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing
Set oFileSys = Nothing

Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.NameSpace(MySource)
oApp.NameSpace(MyTarget).CopyHere oFolder.Items

Craig

unread,
Oct 8, 2004, 12:47:05 PM10/8/04
to
WMI/WSH/VBscript doesn't know anything about the zip format.

One option is to use makecab.exe to script it. Makecab.exe is built into
2000/XP/2003. An example from the Directory Services version of the
MPSReports utility on the MS website:

Function Package()
Set txtCabDirect = fso.CreateTextFile(objLogs.Path &"\CABDIRECT.DDF", True)
txtCabDirect.WriteLine ";***MPS Reports 2000 MakeCAB Directive file" &
vbCrLf &_
";" & vbCrLf &_
".OPTION EXPLICIT" & vbCrLf &_
WshShell.ExpandEnvironmentStrings(".Set
CabinetNameTemplate=%COMPUTERNAME%_MPSReports.CAB") & vbCrLf &_
".set DiskDirectoryTemplate=.\cab" & vbCrLf &_
".Set MaxDiskSize=CDROM" & vbCrLf &_
".Set FolderSizeThreshold=2000000" & vbCrLf &_
".Set CompressionType=MSZIP" & vbCrLf &_
".Set Cabinet=on" & vbCrLf &_
".Set Compress=on"
For Each oFile In objLogs.Files
If UCASE(WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")) = _

UCase(Left(oFile.Name,Len(WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")))) Then txtCabDirect.WriteLine oFile.Path
Next
txtCabDirect.Close

Package = WshShell.Run("cmd /c cd /d %MPSLogs% & MakeCAB /f CABDIRECT.DDF
/L %MPSLogs%\cab", 7, TRUE)
End Function

Hal Rosser

unread,
Oct 8, 2004, 8:59:37 PM10/8/04
to

"Red" <cap...@yahoo.co.uk> wrote in message
news:5eb6d95.04100...@posting.google.com...

> Help why doesn't this zip work it creates the .ZIP file but does not
> copy the source to it?!??! No errors, I can drag files into the .zip
> created with the script what gives?
> Also tried different source and locations -thanks.

if you use the dos version of pkzip "pkz204g.exe" - you cna zip files using
a shell command
but pkzip needs to be installed

---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.772 / Virus Database: 519 - Release Date: 10/1/2004


Johan Karlsson

unread,
Oct 9, 2004, 4:12:35 AM10/9/04
to
Info-zip may be an option. Also, WinZip has an API.

http://www.info-zip.org/

Regards, Johan Karlsson


"Red" <cap...@yahoo.co.uk> wrote in message
news:5eb6d95.04100...@posting.google.com...

Joe Fawcett

unread,
Oct 9, 2004, 4:31:05 AM10/9/04
to
And ZipGenius...
"Johan Karlsson" <yoh...@tjohoo.se> wrote in message
news:OIFfcgdr...@tk2msftngp13.phx.gbl...

SumYungGuy

unread,
Oct 9, 2004, 7:22:04 AM10/9/04
to
"Craig" <Cr...@discussions.microsoft.com> wrote in message news:<2EBFFB3E-F61D-4290...@microsoft.com>...

> WMI/WSH/VBscript doesn't know anything about the zip format.

Right, but the Windows Shell does, so the attempt is to use the
automatic invocation of zipfldrs.dll that the shell application to
handle "zip folders" automagically.

Red, I found this code snippet the same place you did I imagine, and I
have the same problem. It appears to work but does not. Somebody's
going to figure this out soon I suspect. I just hope they post in a
language I speak/read.


>
> One option is to use makecab.exe to script it. Makecab.exe is built into
> 2000/XP/2003. An example from the Directory Services version of the
> MPSReports utility on the MS website:
>

Was hoping to avoid that...

<snip />

Message has been deleted

Miyahn

unread,
Oct 9, 2004, 12:50:31 PM10/9/04
to
"Red" wrote in message news:5eb6d95.04100...@posting.google.com

> Help why doesn't this zip work it creates the .ZIP file but does not
> copy the source to it?!??! No errors, I can drag files into the .zip
> created with the script what gives?
> Also tried different source and locations -thanks.

Try this "unreliable" script at your own risk.

Const ssfSendTo = 9, MySource = "C:\tmp", MyZipName = "C:\temp\SinkFolder.zip"
Dim WS, FS, SA, ZipFile
Set WS = CreateObject("WScript.Shell")
Set FS = CreateObject("Scripting.FileSystemObject")
Set SA = CreateObject("Shell.Application")
FS.CreateTextFile(MyZipName, True).Write _
Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, Chr(0))
SA.Open SA.NameSpace(MyZipName)
WScript.Sleep 100
WS.SendKeys "%{F4}", True
FS.DeleteFile MyZipName
SelectItem MySource, ""
WS.SendKeys "^(ac)", True
WS.SendKeys "%{F4}", True
SelectItem ssfSendTo, "Compressed (zipped) Folder.ZFSendToTarget"
WS.SendKeys "+{F10}P", True
WS.SendKeys "%{F4}", True
ZipFile = FS.BuildPath(MySource, ZipFile)
Do Until FS.FileExists(ZipFile): WScript.Sleep 100: Loop
On Error Resume Next
Do
FS.GetFile(ZipFile).Move MyZipName
WScript.Sleep 100
Loop While Err
On Error GoTo 0
Set SA = Nothing: Set FS = Nothing: Set WS = Nothing
'
Sub SelectItem(Parent, Target)
SA.Open SA.NameSpace(Parent)
WScript.Sleep 100
For Each aWin In SA.Windows
If aWin.Document.Folder.Items.Item.Path = SA.NameSpace(Parent).Items.Item.Path Then
If Target <> "" Then
aWin.Document.SelectItem SA.NameSpace(Parent).ParseName(Target), 1
Else
ZipFile = FS.GetBaseName(aWin.Document.FocusedItem.Name) & ".zip"
End If
End If
Next
End Sub

--
Miyahn (Masataka Miyashita) JPN
Microsoft MVP (Office Systems - Excel)
HQF0...@nifty.ne.jp

Craig

unread,
Oct 9, 2004, 10:05:03 PM10/9/04
to
Right, the Windows Shell can handle .zip files, but none of that is exposed
to WMI/WSH/VBScript so you can call it programmatically.

Here is some VB6 code to do it, but its somewhat of a kludge because it just
programmatically does the "send to compressed folder"

http://www.mvps.org/emorcillo/vb6/shell/xpzip.shtml

So that leaves you with calling winzip,winrar,makecab or whatever
compression utility you want from within your script. Or you can use
something like zlib - http://www.winimage.com/zLibDll/ - but that would
require calling it with VB, not vbscript. To make it accessible via vbscript,
you've have to roll your own COM object from it somehow.

Red

unread,
Oct 11, 2004, 11:44:47 AM10/11/04
to
Good god man your a genius it works.

SumYungGuy

unread,
Oct 11, 2004, 7:49:29 PM10/11/04
to
OK, Miyahn, your "unreliable" script works on WinXP SP2 if any
third-party zip utils are not installed. But I am having difficulty
making it work in Server 2003. I appreciate your help. But I am
beginning to lean like the others have posted about using 3rd party.
Or tackling my problem a different way.

Thanks

"Miyahn" <HQF0...@nifty.ne.jp> wrote in message news:<eG6#GAirEH...@TK2MSFTNGP12.phx.gbl>...

Alaric

unread,
Oct 14, 2004, 5:30:42 PM10/14/04
to

That "unreliable" script certainly is, the first script is less error
prone and can be easily fixed by changing it like this
---------
Option Explicit

Const ForReading = 1, ForWriting = 2, ForAppending = 3

Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i

Dim oShell, oApp, oFolder, oCTF
Dim oFileSys

MySource = "C:\wutemp"


MyZipName = "SinkFolder"
MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0)

For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next

Set oShell = CreateObject("WScript.Shell")


Set oFileSys = CreateObject("Scripting.FileSystemObject")

'Use the filesystemobject to get the default windows temp folder
'TemporaryFolder = 2
' and use "BuildPath" to correctly make a path out of it.
MyTarget = oFileSys.BuildPath(oFileSys.GetSpecialFolder(2),
MyZipName & ".zip")
'Create the basis of a zip file.


Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing
Set oFileSys = Nothing

'do the actual zipping here



Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.NameSpace(MySource)

If oFolder Is Nothing Then
'MsgBox "oFolder is nothing"
Else
oApp.NameSpace(MyTarget).MoveHere oFolder.Items
End If

On Error Resume Next
Set oFile = Nothing
While (oFile Is Nothing)
Set oFile = oFileSys.OpenTextFile(MyTarget, ForWriting, False)
wScript.Sleep (100)
Wend

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Miyahn

unread,
Oct 16, 2004, 9:49:34 AM10/16/04
to
"Alaric" wrote in message news:ulb8PUjs...@TK2MSFTNGP12.phx.gbl...
> That "unreliable" script certainly is.

Your's too.
The last part of your script construct the infinite loop.

Alaric

unread,
Oct 20, 2004, 9:30:32 AM10/20/04
to

Look again, its waiting for the lock on the file to release. Once the
lock is released the script exits normally, try it.

Miyahn

unread,
Oct 20, 2004, 10:34:13 AM10/20/04
to
"Alaric" wrote in message news:u7FK6jqt...@tk2msftngp13.phx.gbl

> Look again, its waiting for the lock on the file to release. Once the
> lock is released the script exits normally, try it.

I say also "Look again".

Since in your sample code oFileSys is nothing, "while" loop is never ending.
Please check taskmaneger's process tab after execution of script.

Alaric

unread,
Oct 20, 2004, 11:10:37 AM10/20/04
to

I am not going to turn this into a flame war, let me add comments to the
code, since you aren't going to try it ( I ran the code before I posted
it )

On Error Resume Next
'Set oFile to a known state "Nothing"
Set oFile = Nothing

'Loop while oFile is Nothing
While (oFile Is Nothing)
'Try to Get Exclusive access to the file using the
'FileSystemObject 'oFileSys'
'if we cant get exclusive acess oFile will be set
'back to nothing, when the exclusive lock is
'released then ((oFile is Nothing) = False) and the
'Loop will exit


Set oFile = oFileSys.OpenTextFile(MyTarget, ForWriting, False)

'Pause momentarily so the copy has a chance to
'complete so we don't PEG the CPU waiting for the
'lock to release
wScript.Sleep (100)
Wend

Alaric

unread,
Oct 20, 2004, 11:40:32 AM10/20/04
to

Actually, because of this disagreement on if or how the code works I
will show the example I was going to leave to people to how to limit the
time

On Error Resume Next
Set oFile = Nothing
' Change this number to be whatever you need in this
'case the loop will execute a max of 1001 times. this
'gives a 101 * 100 millisecond = 10.1 second timeout
For x = 0 to 100
'by moving the sleep above the attempt to open the file
'exclusively, we eliminate an extra sleep
wScript.Sleep (100)

Set oFile = oFileSys.OpenTextFile(MyTarget, ForWriting, False)

If Not(oFile is Nothing) Then
'The clean up I ommited previously
oFile.Close
Set oFile = Nothing
Exit For
End If
Next

Miyahn

unread,
Oct 20, 2004, 11:50:56 AM10/20/04
to
"Alaric" wrote in message news:#0Qh1brt...@TK2MSFTNGP11.phx.gbl

>
> I am not going to turn this into a flame war,
me too.

> let me add comments to the
> code, since you aren't going to try it ( I ran the code before I posted
> it )

No. I have tried the script of your 1st post.
I copy and paste your code to notepad and saveas "Test.vbs".
Then execute the script and check the taskmaneger's process tab.
The process "Wscript" keep alive.

Please note preceding line "Set oFileSys = Nothing".

The following is quote from your 1st post.

> Set oCTF = Nothing
> Set oFileSys = Nothing
> 'do the actual zipping here
>
> Set oApp = CreateObject("Shell.Application")
> Set oFolder = oApp.NameSpace(MySource)
> If oFolder Is Nothing Then
> 'MsgBox "oFolder is nothing"
> Else
> oApp.NameSpace(MyTarget).MoveHere oFolder.Items
> End If
>

> On Error Resume Next
> Set oFile = Nothing
> While (oFile Is Nothing)


> Set oFile = oFileSys.OpenTextFile(MyTarget, ForWriting, False)

> wScript.Sleep (100)
> Wend

Philip

unread,
Nov 4, 2004, 11:50:08 AM11/4/04
to
I've corrected the code to work on my system. The ForAppending = 3
constant really screwed me up, it is supposed to be 8. This is what I
got, hope it helps someone.

Option Explicit

Const ForReading = 1, ForWriting = 2, ForAppending = 8

Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i

Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys

MySource = "c:\WUTemp"
MyTarget = "c:\SinkFolder.zip"



MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0)

For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next

Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")

'Create the basis of a zip file.


Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close

Set oCTF = Nothing


Set oApp = CreateObject("Shell.Application")

'Copy the files to the compressed folder
Set oFolder = oApp.NameSpace(MySource)
If Not oFolder Is Nothing Then
oApp.NameSpace(MyTarget).CopyHere oFolder.Items
End If

'Wait for compressing to begin, this was necessary on my machine
wScript.Sleep(5000)

'wait for lock to release
Set oFile = Nothing
On Error Resume Next
Do While (oFile Is Nothing)
'Attempt to open the file, this causes an Err 70, Permission Denied
when the file is already open
Set oFile = oFileSys.OpenTextFile(MyTarget, ForAppending, False)
If Err.number <> 0 then
Err.Clear
wScript.Sleep 3000
End If
Loop

Set oFile=Nothing
Set oFileSys=Nothing

Paul Gee

unread,
May 18, 2005, 12:59:04 PM5/18/05
to

Red wrote:
> *Help why doesn't this zip work it creates the .ZIP file but does
> oApp.NameSpace(MyTarget).CopyHere oFolder.Items *


Did you ever get this to wrk, using the code supplied with the
suggested tweaks I'm getting the zip file produced but then receiving
an error message "Cannot create or replace SinkFolder: There is already
a file with the folder name you specified. Specify a different name."
Tried removing the zip, renaming still get the same message. I'm trying
to use this method within a DTs packgae in SQL.

--
Paul Gee
------------------------------------------------------------------------
Posted via http://www.codecomments.com
------------------------------------------------------------------------

jort777

unread,
Feb 8, 2006, 10:38:21 AM2/8/06
to

Paul Gee wrote:
> *Did you ever get this to wrk, using the code supplied with the

> suggested tweaks I'm getting the zip file produced but then receiving
> an error message "Cannot create or replace SinkFolder: There is
> already a file with the folder name you specified. Specify a
> different name." Tried removing the zip, renaming still get the same
> message. I'm trying to use this method within a DTs packgae in SQL. *

I used the script from Philip (not sure who posted it first) and it
works perfectly on my system.

The question now is ... How can I add a password to it?

=======================================
To make sure we talk about the same script, this is the one I used:

Option Explicit

Const ForReading = 1, ForWriting = 2, ForAppending = 8

Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i


Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys

MySource = "c:\WUTemp"
MyTarget = "c:\SinkFolder.zip"

MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0)

For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next

Set oShell = CreateObject("WScript.Shell")

Set oFileSys = CreateObject("Scripting.FileSystemObject")

'Create the basis of a zip file.


Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing

Set oApp = CreateObject("Shell.Application")

'Copy the files to the compressed folder


Set oFolder = oApp.NameSpace(MySource)
If Not oFolder Is Nothing Then
oApp.NameSpace(MyTarget).CopyHere oFolder.Items
End If

'Wait for compressing to begin, this was necessary on my machine
wScript.Sleep(5000)

'wait for lock to release
Set oFile = Nothing
On Error Resume Next
Do While (oFile Is Nothing)
'Attempt to open the file, this causes an Err 70, Permission Denied
when the file is already open
Set oFile = oFileSys.OpenTextFile(MyTarget, ForAppending, False)
If Err.number <> 0 then
Err.Clear
wScript.Sleep 3000
End If
Loop

Set oFile=Nothing
Set oFileSys=Nothing

--
jort777

tro...@gmail.com

unread,
Feb 14, 2006, 11:03:00 PM2/14/06
to
Any idea on how one might do an extraction from a zip file using a
similar mechanism to how this zip folder was created? I messed around
with it a bit, but to no avail.

jg

unread,
Feb 20, 2006, 2:08:07 AM2/20/06
to
or you get download 7-zip from sourceforge.net and use it's command line
options
quick simple and easy
"jort777" <jort777...@mail.codecomments.com> wrote in message
news:jort777...@mail.codecomments.com...
Reply all
Reply to author
Forward
0 new messages