Monday, February 1, 2010

How To Zip The Folder using VB script

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