Option Explicit
Const FOF_SIMPLEPROGRESS = 256
Dim MySource, MyTarget, MyHex, MyBinary, i
Dim oShell, oCTF
Dim oFileSys
dim winShell
Const cstrApp = "Zip It"
MySource = InputBox("Enter path to folder to zip (Ex:D:\xyzfolder)", cstrApp ) 'Example :"D:\test\"
MyTarget = InputBox("Enter path and name of Zip file (Ex:D:\xyz.zip)", cstrApp)'"D:\smp.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
'Add File to zip
set winShell = createObject("shell.application")
winShell.namespace(MyTarget).CopyHere MySource
wScript.Sleep(5000)
'Follow these steps only if you're receiving the 800A01AD error for Wscript.Shell component. For any other ActiveX object, the following steps does not apply:
'Click Start, Run and type:
' * regsvr32 wshom.ocx
' * regsvr32 scrrun.dll
Const FOF_SIMPLEPROGRESS = 256
Dim MySource, MyTarget, MyHex, MyBinary, i
Dim oShell, oCTF
Dim oFileSys
dim winShell
Const cstrApp = "Zip It"
MySource = InputBox("Enter path to folder to zip (Ex:D:\xyzfolder)", cstrApp ) 'Example :"D:\test\"
MyTarget = InputBox("Enter path and name of Zip file (Ex:D:\xyz.zip)", cstrApp)'"D:\smp.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
'Add File to zip
set winShell = createObject("shell.application")
winShell.namespace(MyTarget).CopyHere MySource
wScript.Sleep(5000)
'Follow these steps only if you're receiving the 800A01AD error for Wscript.Shell component. For any other ActiveX object, the following steps does not apply:
'Click Start, Run and type:
' * regsvr32 wshom.ocx
' * regsvr32 scrrun.dll
No comments:
Post a Comment