VBS extract a zip out of url [Code Example]

VBS extract a zip out of url [Code Example]

Reading Time: 1 minute

Never thought I would touch any kind of Microsoft languages, but I had to develop some solution that included creating a file for MS Windows that eventually will get input in form of URL of a zip file (that is also automatically generated by some PHP server code – not on this post’s scope) and the output is unzipping the zip file’s contents to a certain location.

' SET THE LOCATION WHERE WE WANT TO UNZIP FILES
Set objNetwork = CreateObject("Wscript.Network")
loc = "C:\Users\" & objNetwork.UserName & "\WHATEVER_DIR_YOU_WANT"
 
' OR EASIER WAY:
' Set oShell = CreateObject("WScript.Shell")
' strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
' loc = strHomeFolder & "\WHATEVER_DIR_YOU_WANT"
 
' -----------------------------------------------------------------
 
' DOWNLOAD THE ZIP FILE
' {{file_name}} IS A PLACE HOLDER THAT IS REPLACED IN THE SERVER IN WHATEVER INPUT URL OF ZIP I GET
' THE SECOND PARAMETER IS WHERE TO DOWNLOAD THE ZIP TO (LOOK FOR THE SUB HTTPDownload)
HTTPDownload "{{file_name}}", loc
 
' -----------------------------------------------------------------
 
' EXTRACT ZIP FILE
 
' THE ZIP FILE WE JUST DOWNLOADED LOCATION
ZipFile = loc & "\{{file_name}}"
ExtractTo = loc
 
' CREATE DIRECTORY WHERE WE WANT TO UNZIP IF NOT EXISTS
Set fso = CreateObject("Scripting.FileSystemObject")
If NOT fso.FolderExists(ExtractTo) Then
   fso.CreateFolder(ExtractTo)
End If
 
' EXTRACT
set objShell = CreateObject("Shell.Application")
set FilesInZip = objShell.NameSpace(ZipFile).items
objShell.NameSpace(ExtractTo).CopyHere(FilesInZip)
Set fso = Nothing
Set objShell = Nothing
 
' DELETE THE ZIP FILE (LOOK FOR THE SUB DeleteAFile)
DeleteAFile loc & "\{{file_name}}"
 
WScript.Echo "Zip successfully unzipped."
 
' ------------------------------------------------------------------
 
' --------------------- SUBS I USED WITH CREDITS -------------------
Sub HTTPDownload( myURL, myPath )
    Dim i, objFile, objFSO, objHTTP, strFile, strMsg
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
    Set objFSO = CreateObject( "Scripting.FileSystemObject" )
 
    If objFSO.FolderExists( myPath ) Then
        strFile = objFSO.BuildPath( myPath, Mid( myURL, InStrRev( myURL, "/" ) + 1 ) )
    ElseIf objFSO.FolderExists( Left( myPath, InStrRev( myPath, "\" ) - 1 ) ) Then
        strFile = myPath
    Else
        WScript.Echo "ERROR: Target folder not found."
        Exit Sub
    End If
 
    Set objFile = objFSO.OpenTextFile( strFile, ForWriting, True )
 
    Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
 
    objHTTP.Open "GET", myURL, False
    objHTTP.Send
 
    For i = 1 To LenB( objHTTP.ResponseBody )
        objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )
    Next
 
    objFile.Close( )
End Sub
 
Sub DeleteAFile(filespec)
   Dim fso
   Set fso = CreateObject("Scripting.FileSystemObject")
   fso.DeleteFile(filespec)
End Sub

It looks simple but so useful for making 1 file installer (kinda) with 0 work!

Credits: