Welcome to the forum!
'Written: October 26, 2016'Author: Leith Ross
'Summary: Function Downloads A Web Site Resource To A Local Disk File
Private Const E_OUTOFMEMORY As Long = &H8007000E
Private Const INET_E_DOWNLOAD_FAILURE As Long = &H800C0008
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
Function DownloadURLtoFile(ByVal URL As String, ByVal vFolder As Variant, ByVal FileName As String) As Boolean
Dim Msg As String
Dim oFolder As Object
With CreateObject("Shell.Application")
Set oFolder = .Namespace(vFolder)
End With
If oFolder Is Nothing Then
MsgBox "Folder '" & vFolder & "' Not Found.", vbExclamation
Exit Function
End If
Select Case URLDownloadToFile(0&, URL, vFolder & FileName, 0&, 0&)
Case 0: DownloadURLtoFile = True
Case E_OUTOFMEMORY: Msg = "Insufficient Memory To Complete The Operation."
Case INET_E_DOWNLOAD_FAILURE: Msg = "The Specified Resource Or Callback Interface Was Invalid."
End Select
If Not DownloadURLtoFile Then Debug.Print Msg
End Function
Sub DownloadAndSave()
Dim Cell As Range, Cell2 As Range, Folder As String, Folder2 As String
Dim FSO, fn As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Folder = CreateObject("Wscript.Shell").Specialfolders("Desktop") & "\"
On Error Resume Next
For Each Cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
Set Cell2 = Cell.Offset(, 1)
Folder2 = Folder & Cell2.Value2 & "\"
MkDir Folder2
fn = FSO.GetFilename(Cell.Value2)
If Dir(fn) = "" Then _
DownloadURLtoFile Cell.Value2, Folder2, fn
Next Cell
MsgBox "Done...", 64
Set FSO = Nothing
End Sub