Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Dim Ret As Long
'> This is where the files will be saved. Change as applicable
Const FolderName As String = "C:\Users\a3rgcw\Downloads\"
Sub Download()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String
Set ws = Sheets("Sheet1")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
strPath = FolderName & "File" & i & ".zip"
Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)
If Ret = 0 Then
ws.Range("C" & i).Value = "File successfully downloaded"
Else
ws.Range("C" & i).Value = "Unable to download the file"
End If
Next i
UnZipMe
End Sub
Sub UnZipMe()
Dim str_FILENAME As String, str_DESTINATION As String
Dim c As Range
'Loop through all zip files in the directory
str_FILENAME = Dir(FolderName & "*.zip")
Do While Len(str_FILENAME) > 0
Call Unzip1(FolderName & str_FILENAME)
str_FILENAME = Dir
Loop
End Sub
Sub Unzip1(str_FILENAME As String)
Dim oApp As Object
Dim Fname As Variant
Dim FnameTrunc As Variant
Dim FnameLength As Long
Fname = str_FILENAME
FnameLength = Len(Fname)
FnameTrunc = Left(Fname, FnameLength - 4) & "\"
On Error Resume Next
MkDir FnameTrunc
'Extract the files into the folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items
Kill Fname
End Sub
