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