Zip and Extract Files VBScript

Example scripts and tips (replaces Old Scripts & Tips archive)

Moderators: Dorian (MJT support), JRL, Phil Pendlebury

Post Reply
User avatar
Rain
Automation Wizard
Posts: 550
Joined: Tue Aug 09, 2005 5:02 pm
Contact:

Zip and Extract Files VBScript

Post by Rain » Thu Mar 21, 2013 4:52 pm

Zip/Compress a single file, Zip/Compress files and sub directories in a folder, and Unzip/Extract a Zip file VBScript examples.

Zip file functions are included in Macro Scheduler 14+.
See: ZipAddFiles, ZipExtractFiles


Extract files from a zip file

Code: Select all

VBSTART
'Unzip file function
Function UnzipFile(ZippedFile,OutputDir)
'The location of your zip file.
ZipFile = ZippedFile
'The folder the contents should be extracted to.
ExtractTo = OutputDir
'If the extraction location does not exist create it.
Set fso = CreateObject("Scripting.FileSystemObject")
If NOT fso.FolderExists(ExtractTo) Then
   fso.CreateFolder(ExtractTo)
End If
'Extract the contants of the zip file.
set objShell = CreateObject("Shell.Application")
set FilesInZip=objShell.NameSpace(ZipFile).items
objShell.NameSpace(ExtractTo).CopyHere(FilesInZip)
Set fso = Nothing
Set objShell = Nothing
End Function
VBEND

//Unzip function
Let>ZipFile=C:\test.zip
Let>OutputDir=C:
VBEval>UnzipFile("%ZipFile%","%OutputDir%"),res



Zip/Compress a single file

Code: Select all

VBSTART
'Compress file function
Function CompressFile(SourceFile,TargetFile)
Const FOF_SIMPLEPROGRESS = 256
Dim MySource, MyTarget, MyHex, MyBinary, i
Dim oShell, oCTF
Dim oFileSys
dim winShell
'The location of the file to compress
MySource = SourceFile
'The location of the zip file
MyTarget = TargetFile
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 a zip file.
   Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
   oCTF.Write MyBinary
   oCTF.Close
   Set oCTF = Nothing
'Add Source File to zip.
   set winShell = createObject("shell.application")
   winShell.namespace(MyTarget).CopyHere MySource
End Function
VBEND

//Zip function
Let>InputSourceFile=C:\temp.txt
Let>OutputFile=C:\test.zip
VBEval>CompressFile("%InputSourceFile%","%OutputFile%"),res



Zip/Compress files and sub directories in a folder

Code: Select all

VBSTART
'Compress folder function
Function CompressFolder(SourceFolder,TargetFile)

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

Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
'The location of the folder to compress
MySource = SourceFolder
'The location of the zip file
MyTarget = TargetFile

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 a zip file.
Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing

Set oApp = CreateObject("Shell.Application")

'Add Source Folder to zip.
Set oFolder = oApp.NameSpace(MySource)
If Not oFolder Is Nothing Then
oApp.NameSpace(MyTarget).CopyHere oFolder.Items
End If

Set oFile=Nothing
Set oFileSys=Nothing
End Function
VBEND

//Zip Content of a folder function
Let>InputFolder=C:\Temp
Let>ZipOutput=C:\test.zip
VBEval>CompressFolder("%InputFolder%","%ZipOutput%"),res



All three methods combined

Code: Select all

VBSTART

'Unzip file function
Function UnzipFile(ZippedFile,OutputDir)
'The location of your zip file.
ZipFile = ZippedFile
'The folder the contents should be extracted to.
ExtractTo = OutputDir
'If the extraction location does not exist create it.
Set fso = CreateObject("Scripting.FileSystemObject")
If NOT fso.FolderExists(ExtractTo) Then
   fso.CreateFolder(ExtractTo)
End If
'Extract the contants of the zip file.
set objShell = CreateObject("Shell.Application")
set FilesInZip=objShell.NameSpace(ZipFile).items
objShell.NameSpace(ExtractTo).CopyHere(FilesInZip)
Set fso = Nothing
Set objShell = Nothing
End Function

'Compress file function
Function CompressFile(SourceFile,TargetFile)
Const FOF_SIMPLEPROGRESS = 256
Dim MySource, MyTarget, MyHex, MyBinary, i
Dim oShell, oCTF
Dim oFileSys
dim winShell
'The location of the file to compress
MySource = SourceFile
'The location of the zip file
MyTarget = TargetFile
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 a zip file.
   Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
   oCTF.Write MyBinary
   oCTF.Close
   Set oCTF = Nothing
'Add Source File to zip.
   set winShell = createObject("shell.application")
   winShell.namespace(MyTarget).CopyHere MySource
End Function

'Compress folder function
Function CompressFolder(SourceFolder,TargetFile)

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

Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
'The location of the folder to compress
MySource = SourceFolder
'The location of the zip file
MyTarget = TargetFile

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 a zip file.
Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing

Set oApp = CreateObject("Shell.Application")

'Add Source Folder to zip.
Set oFolder = oApp.NameSpace(MySource)
If Not oFolder Is Nothing Then
oApp.NameSpace(MyTarget).CopyHere oFolder.Items
End If

Set oFile=Nothing
Set oFileSys=Nothing
End Function

VBEND


//Unzip function
Let>ZipFile=C:\test.zip
Let>OutputDir=C:
VBEval>UnzipFile("%ZipFile%","%OutputDir%"),res


//Zip function
Let>InputSourceFile=C:\temp.txt
Let>OutputFile=C:\test.zip
VBEval>CompressFile("%InputSourceFile%","%OutputFile%"),res


//Zip Content of a folder function
Let>InputFolder=C:\Temp
Let>ZipOutput=C:\test.zip
VBEval>CompressFolder("%InputFolder%","%ZipOutput%"),res

Post Reply
cron
Sign up to our newsletter for free automation tips, tricks & discounts