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