Zip a file programatically
Red
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
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
"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
Regards, Johan Karlsson
"Red" <cap...@yahoo.co.uk> wrote in message
news:5eb6d95.04100...@posting.google.com...
Joe Fawcett
"Johan Karlsson" <yoh...@tjohoo.se> wrote in message
news:OIFfcgdr...@tk2msftngp13.phx.gbl...
SumYungGuy
> 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 />
Miyahn
> 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
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
SumYungGuy
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
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
> That "unreliable" script certainly is.
Your's too.
The last part of your script construct the infinite loop.
Alaric
Look again, its waiting for the lock on the file to release. Once the
lock is released the script exits normally, try it.
Miyahn
> 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
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
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
>
> 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 )
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
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
Red wrote:
> *Help why doesn't this zip work it creates the .ZIP file but does
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
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
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
similar mechanism to how this zip folder was created? I messed around
with it a bit, but to no avail.
jg
options
quick simple and easy
"jort777" <jort777...@mail.codecomments.com> wrote in message
news:jort777...@mail.codecomments.com...