Results 1 to 4 of 4

Thread: VBA to Download documents using URLs, create a folder and save it in

  1. #1
    VBAX Newbie
    Jun 2018

    VBA to Download documents using URLs, create a folder and save it in


    I found a VBA code on the forum that works perfectly, it downloads the URL images from the column A and saves it by the name specified in column B.

    But instead of saving it by the name in column B, I would need to create a folder named from the values in column B and save the files there.

    In column B I have duplicated values, so that means the cells with the same value are saved in the same folder. Names of the files can be same as the URLs.

    Could anyone please please help me, it will save me a lot of time



  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Nov 2005
    Tecumseh, OK
    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

  3. #3
    VBAX Newbie
    Jun 2018
    Hi Kenneth,

    Thank you SOOOO much!!!

    But I have one issue, it doesn't allow me to save it anywhere else other than Desktop. I've changed the path, but no success it says Folder does not exist.

  4. #4
    VBAX Newbie
    Jun 2018
    I got it now, the path wasn't correct. It works brilliantly, thank you again.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts