Skip to content

Instantly share code, notes, and snippets.

@simply-coded
Last active July 21, 2024 05:29
Show Gist options
  • Save simply-coded/1b3a4d35b6e6adc5fe0643fab985eea6 to your computer and use it in GitHub Desktop.
Save simply-coded/1b3a4d35b6e6adc5fe0643fab985eea6 to your computer and use it in GitHub Desktop.
Compress and decompress zip files in VBScript.
Function QuickZip(path)
'@description: Compress and uncompress zip files.
'@author: Jeremy England (SimplyCoded)
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
Dim oSap : Set oSap = CreateObject("Shell.Application")
Dim oWss : Set oWss = CreateObject("WScript.Shell")
Dim isZip, count, root, base, add, out
Dim isZipping, isCancelable
Const NOT_FOUND = 1
Const NOT_A_ZIP = 2
Const USER_QUIT = 3
'CHECK INPUT
Select Case oFso.GetExtensionName(path)
Case "zip"
If Not oFso.FileExists(path) Then QuickZip = NOT_FOUND : Exit Function Else isZip = True
Case ""
If Not oFso.FolderExists(path) Then QuickZip = NOT_FOUND : Exit Function Else isZip = False
Case Else
QuickZip = NOT_A_ZIP : Exit Function
End Select
'DECOMPRESS
If isZip Then
root = oFso.GetParentFolderName(path)
base = oFso.GetBaseName(path)
out = root & "\" & base
If oFso.FolderExists(out) Then
add = 2 : Do
out = root & "\" & base & "-" & add
If Not oFso.FolderExists(out) Then Exit Do
add = add + 1
Loop
End If
oFso.CreateFolder(out)
oSap.NameSpace(out).CopyHere(oSap.NameSpace(path).Items)
If FileCount(oSap, path) = FileCount(oSap, out) Then QuickZip = out _
Else oFso.DeleteFolder out, True : QuickZip = USER_QUIT
'COMPRESS
Else
out = path & ".zip"
If oFso.FileExists(out) Then
add = 2 : Do
out = path & "-" & add & ".zip"
If Not oFso.FileExists(out) Then Exit Do
add = add + 1
Loop
End If
With oFso.CreateTextFile (out, True)
.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0) : .Close
End With
oSap.NameSpace(out).CopyHere(oSap.NameSpace(path).Items)
count = FileCount(oSap, path)
Do While count > FileCount(oSap, out)
WScript.Sleep(200)
isZipping = oWss.Run("powershell.exe -command " & _
"""if (get-process wscript, cscript -ea 0 | where MainWindowTitle -match '(\d{1,3}% complete)|(Compressing...)') {exit -1} else {exit 0}""", 0, True)
If isZipping Then
oWss.Run "powershell.exe -command " & _
"""while (get-process wscript, cscript -ea 0 | where MainWindowTitle -match '(\d{1,3}% complete)|(Compressing...)') {start-sleep -m 200} ; exit""", 0, True
Exit Do
End If
Loop
If count = FileCount(oSap, out) Then QuickZip = out _
Else oFso.DeleteFile out, True : QuickZip = USER_QUIT
End If
End Function
Function FileCount(oSap, path)
FileCount = FileCount + oSap.NameSpace(path).Items.Count
Dim oItem
For Each oItem In oSap.NameSpace(path).Items
If oItem.IsFolder Then _
FileCount = FileCount + FileCount(oSap, oItem.Path)
Next
End Function
'Compress by giving a location of a folder
QuickZip("c:\location\of\folder")
'Decompress by giving a location of a zip file
QuickZip("c:\location\of\file.zip")
'Function returns the output path
createdZipPath = QuickZip("c:\location\of\folder")
createdFolderPath = QuickZip("c:\location\of\file.zip")
'Returns an integer if canceled or wrong input data
productPath = QuickZip("c:\users\jeremy\desktop\custom")
If IsNumeric(productPath) Then
Select Case productPath
Case 1: MsgBox "Path not found.", vbCritical
Case 2: MsgBox "Not a zip file.", vbCritical
Case 3: MsgBox "Process canceled.", vbCritical
End Select
Else
MsgBox productPath, vbInformation
End If
'=============================================================================================
Function QuickZip(path)
'@description: Compress and uncompress zip files.
'@author: Jeremy England (SimplyCoded)
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
Dim oSap : Set oSap = CreateObject("Shell.Application")
Dim oWss : Set oWss = CreateObject("WScript.Shell")
Dim isZip, count, root, base, add, out
Dim isZipping, isCancelable
Const NOT_FOUND = 1
Const NOT_A_ZIP = 2
Const USER_QUIT = 3
'CHECK INPUT
Select Case oFso.GetExtensionName(path)
Case "zip"
If Not oFso.FileExists(path) Then QuickZip = NOT_FOUND : Exit Function Else isZip = True
Case ""
If Not oFso.FolderExists(path) Then QuickZip = NOT_FOUND : Exit Function Else isZip = False
Case Else
QuickZip = NOT_A_ZIP : Exit Function
End Select
'DECOMPRESS
If isZip Then
root = oFso.GetParentFolderName(path)
base = oFso.GetBaseName(path)
out = root & "\" & base
If oFso.FolderExists(out) Then
add = 2 : Do
out = root & "\" & base & "-" & add
If Not oFso.FolderExists(out) Then Exit Do
add = add + 1
Loop
End If
oFso.CreateFolder(out)
oSap.NameSpace(out).CopyHere(oSap.NameSpace(path).Items)
If FileCount(oSap, path) = FileCount(oSap, out) Then QuickZip = out _
Else oFso.DeleteFolder out, True : QuickZip = USER_QUIT
'COMPRESS
Else
out = path & ".zip"
If oFso.FileExists(out) Then
add = 2 : Do
out = path & "-" & add & ".zip"
If Not oFso.FileExists(out) Then Exit Do
add = add + 1
Loop
End If
With oFso.CreateTextFile (out, True)
.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0) : .Close
End With
oSap.NameSpace(out).CopyHere(oSap.NameSpace(path).Items)
count = FileCount(oSap, path)
Do While count > FileCount(oSap, out)
WScript.Sleep(200)
isZipping = oWss.Run("powershell.exe -command " & _
"""if (get-process wscript, cscript -ea 0 | where MainWindowTitle -match '(\d{1,3}% complete)|(Compressing...)') {exit -1} else {exit 0}""", 0, True)
If isZipping Then
oWss.Run "powershell.exe -command " & _
"""while (get-process wscript, cscript -ea 0 | where MainWindowTitle -match '(\d{1,3}% complete)|(Compressing...)') {start-sleep -m 200} ; exit""", 0, True
Exit Do
End If
Loop
If count = FileCount(oSap, out) Then QuickZip = out _
Else oFso.DeleteFile out, True : QuickZip = USER_QUIT
End If
End Function
Function FileCount(oSap, path)
FileCount = FileCount + oSap.NameSpace(path).Items.Count
Dim oItem
For Each oItem In oSap.NameSpace(path).Items
If oItem.IsFolder Then _
FileCount = FileCount + FileCount(oSap, oItem.Path)
Next
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment