Compress and decompress zip files in VBScript.

QuickZip.vbs

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

usage.vbs

'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