Use VBA to download zip file and unzip the file?

Hello VAer,

I wrote this macro to download a zip file from a website or local storage. What I found was the URL for a zip file on a website opens a download page and then the server downloads the file to your download folder.

The macro works on my local intranet and local storage with no problem. So, perhaps you will find it useful. The API code used is for 32 bit Windows and Office. If you experience a problem with the API call then I will need to provide you with the 64 bit API call.

Download and Unzip File

Option Explicit

' Written:  February 01, 2018
' Author:   Leith Ross
' Summary:  Downloads a zip file from the internet to a specified folder.
'           A subfolder is created with the name of the zip file where
'           the unzipped files are saved.

Private Const E_ABORT                   As Long = &H80004004
Private Const E_OUTOFMEMORY             As Long = &H8007000E
Private Const INET_E_INVALID_URL        As Long = &H800C0002
Private Const INET_E_RESOURCE_NOT_FOUND As Long = &H800C0005
Private Const INET_E_DOWNLOAD_FAILURE   As Long = &H800C0008
Private Const INET_E_CONNECTION_TIMEOUT As Long = &H800C000B
Private Const INET_E_UNKNOWN_PROTOCOL   As Long = &H800C000D

' API call to download the file.
Private Declare Function URLDownloadToFile _
    Lib "urlmon.dll" Alias "URLDownloadToFileA" _
        (ByVal pCaller As Long, _
         ByVal szURL As String, _
         ByVal szFileName As String, _
         ByVal dwReserved As Long, _
         ByVal lpfnCB As Long) _
    As Long
    
Sub DownloadAndUnzip(ByVal URL As Variant, ByVal FolderPath As Variant)

    Dim btns        As Integer
    Dim msg         As String
    Dim oArchive    As Object
    Dim oFolder     As Object
    Dim oShell      As Object
    Dim Path        As String
    Dim ret         As Long
    Dim slash       As Long
    Dim Subfolder   As Variant
    Dim Title       As String
    Dim ZipFile     As Object
    Dim ZipFolder   As Variant
    
        If LCase(Right(URL, 4)) <> ".zip" Then
            MsgBox "The file must have a ZIP extension.", vbCritical, "Download File"
            Exit Sub
        End If
        
        Set oShell = CreateObject("Shell.Application")
        
        Set oFolder = oShell.Namespace(FolderPath)
            If oFolder Is Nothing Then
                MsgBox "Directory Not Found for:" & vbLf & vbLf & FolderPath, vbExclamation, "Download File"
                Exit Sub
            End If
        
        ' Determine if URL is a network address or local file address.
        slash = IIf(InStr(1, URL, "//") > 0, InStrRev(URL, "/"), InStrRev(URL, "\"))
        
        Path = oFolder.Self.Path & "\"
        Subfolder = Mid(URL, slash + 1, Len(URL) - slash - 4)
            
        ' Download the file.
        ret = URLDownloadToFile(0&, URL, Path, 0&, 0&)
            
            ' Check the download status.
            If ret <> 0 Then
                btns = vbOKOnly + vbCritical
                Title = "Download Error"
            End If
            
            Select Case ret
                Case 0:                         msg = "Download complete!": Title = "File Download"
                Case INET_E_UNKNOWN_PROTOCOL:   msg = "The Protocol is Not Known."
                Case INET_E_INVALID_URL:        msg = "The URL could Not be Parsed."
                Case E_OUTOFMEMORY:             msg = "Insufficient Memory to Complete the Operation."
                Case INET_E_DOWNLOAD_FAILURE:   msg = "The Specified Resource or Callback Interface was Invalid."
                Case E_ABORT:                   msg = "Cannot Download File Directly from the Site."
                Case INET_E_RESOURCE_NOT_FOUND: msg = "Server, Proxy, Folder, or File was Not Found."
                Case INET_E_CONNECTION_TIMEOUT: msg = "The Internet Connection has Timed Out."
                Case Else:                      msg = "URL error '" & Hex(ret) & "':" & vbLf & vbLf & "No error description available."
            End Select
        
            ' Check if download was successful.
            If ret = 0 Then
                ' Create the ZIP archive folder.
                Set oArchive = oFolder.ParseName(Subfolder)
                    If oArchive Is Nothing Then
                        oFolder.NewFolder Subfolder
                        Set oArchive = oFolder.ParseName(Subfolder)
                    End If
                Set oArchive = oShell.Namespace(Path & Subfolder)
            
                ' UnZip each file to the Archive folder.
                Set ZipFolder = oShell.Namespace(URL)
                    For Each ZipFile In ZipFolder.Items
                        oArchive.CopyHere ZipFile.Path
                    Next ZipFile
            End If
            
        MsgBox msg, btns, Title
        
End Sub

Thanks a lot Mr. Leith for this awesome code ..
I have tested it like that

Sub Test_DownloadAndUnzip_UDF()
    DownloadAndUnzip "http://download947.mediafire.com/rvnsiov3w2ng/m4u3q5xtacz251u/Sample+ZIP+File.zip", ThisWorkbook.Path & "\"
End Sub

but I got empty folder with no files ..
Can you provide me with a valid lonk for a zip example file to make sure the code is working well? and why it is working but give me empty folder with no files?

Hello Yasser,

I encountered this problem as well. When downloading a sample zip file that I uploaded to my MediaFire account. The problem lies in how the server handles the link. When clicked, the server opens a new page which forces the user to click again to start the download.

The API call will download files like pictures from a website with no problem. These files are directly accessible from the server. If the file cannot be directly accessed from the server then additional automation is required to negotiate with the host server to obtain the file.

You can test the macro on a zip file on your hard drive. It will unzip the file to the folder path you provide.

Thank you very much for reply
I had the direct download from the mediafire .. and tried another link and got the same empty folder
Can you give me a working zip example file to test it?

As for the zip file on my hard drive it is working perfect

Hello VBer,

The failure of my first macro to download and unzip a file led me to dig into the Windows API a little deeper. I have created a new macro using a different API that works.

Here is the new macro code and sub that will download a zip file from a website to your desktop.

' Written:  February 07, 2018
' Author:   Leieth Ross
' Summary:  Downloads a Zip File from a website and extracts it to the given folder.


Private Const MAX_BUFFER_LENGTH             As Long = 8162
Private Const API_AGENT_NAME                As String = "VB Program"
Private Const INTERNET_OPEN_TYPE_DIRECT     As Long = 1
Private Const INTERNET_FLAG_NO_CACHE_WRITE  As Long = &H4000000

Private Declare Function InternetCloseHandle _
    Lib "wininet.dll" _
        (ByRef hInet As Long) _
    As Long
    
Private Declare Function InternetOpen _
    Lib "wininet.dll" Alias "InternetOpenA" _
        (ByVal sAgent As String, _
         ByVal lAccessType As Long, _
         ByVal sProxyName As String, _
         ByVal sProxyBypass As String, _
         ByVal lFlags As Long) _
    As Long
    
Private Declare Function InternetReadFile _
    Lib "wininet.dll" _
        (ByVal hFile As Long, _
         ByVal Buffer As String, _
         ByVal lNumBytesToRead As Long, _
         ByRef lNumberOfBytesRead As Long) _
    As Integer
    
Private Declare Function InternetOpenUrl _
    Lib "wininet.dll" Alias "InternetOpenUrlA" _
        (ByVal hInternetSession As Long, _
         ByVal lpszUrl As String, _
         ByVal lpszHeaders As String, _
         ByVal dwHeadersLength As Long, _
         ByVal dwFlags As Long, _
         ByVal dwContext As Long) _
    As Long


Public Sub DownloadAndUnZip(ByVal URL As String, ByVal DownloadFolderPath As Variant)

    Dim Archive     As Object
    Dim Buffer      As String * MAX_BUFFER_LENGTH
    Dim FileData    As String
    Dim hFile       As Long
    Dim hOpen       As Long
    Dim oShell      As Object
    Dim ret         As Long
    Dim Filename    As Variant
    Dim ZipFile     As Variant
    Dim ZipFolder   As Variant
    
        Set oShell = CreateObject("Shell.Application")

        If Not LCase(URL) Like "*://*.*/*.zip" Then
            MsgBox "Bad URL File Path or Name" & vbLf & URL, vbOKOnly + vbCritical
            Exit Sub
        End If
        
        If Dir(DownloadFolderPath, vbDirectory + vbHidden + vbArchive + vbSystem) = "" Then
            MsgBox "Download Folder Not Found" & vbLf & DownloadFolderPath, vbOKOnly + vbCritical
            Exit Sub
        End If
        
        Filename = DownloadFolderPath & "\" & Right$(URL, Len(URL) - InStrRev(URL, "/"))

        hOpen = InternetOpen(API_AGENT_NAME, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
            If hOpen = 0 Then
                MsgBox "Error opening Internet connection"
                Exit Sub
            End If
    
        hFile = InternetOpenUrl(hOpen, URL, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
            If hFile <> 0 Then
                InternetReadFile hFile, Buffer, MAX_BUFFER_LENGTH, ret
                FileData = Buffer
                
                Do While ret <> 0
                    DoEvents
                    InternetReadFile hFile, Buffer, MAX_BUFFER_LENGTH, ret
                    FileData = FileData + Mid(Buffer, 1, ret)
                Loop
                
                Open Filename For Binary Access Write Lock Write As #1
                    Put #1, , FileData
                Close #1
            End If
    
        InternetCloseHandle hFile
        InternetCloseHandle hOpen
        
        ZipFolder = Left(Filename, InStr(Filename, ".zip") - 1)
        
        Set Archive = oShell.Namespace(ZipFolder)
            If Archive Is Nothing Then
                MkDir ZipFolder
                Set Archive = oShell.Namespace(ZipFolder)
            End If
        
        Set ZipFolder = oShell.Namespace(Filename)
            For Each ZipFile In ZipFolder.Items
                Archive.CopyHere ZipFile
            Next ZipFile
      
        Kill Filename
        
End Sub

Sub TestIt()

        DownloadAndUnZip "http://www.football-data.co.uk/mmz4281/1718/all-euro-data-2017-2018.zip", "C:\Users\Owner\Desktop"
        
End Sub

Hello Mr. Leith
I have tested that and I encountered an error run-time '75' (path/file access error) at this line

MkDir ZipFolder

Hello Yasser,

Try setting the download folder path to something other than your desktop.

That's great. Now it is working well
But why the path of desktop failed .. Are there any settings that can be done to allow this path instead of the error access?

I have tested again and found that it succeeds now to download to desktop .. That's too weird
Now it is working perfectly
Thank you very much Mr. Leith

Hello Yasser,

That is strange but I am happy to hear it is now working for you. If you discover any problems, let me know.