Consulting

Results 1 to 4 of 4

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

  1. #1
    VBAX Newbie
    Joined
    Jun 2018
    Posts
    3
    Location

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

    Hi,

    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

    Thanks,

    Avlly

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,549
    Location
    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
    Joined
    Jun 2018
    Posts
    3
    Location
    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
    Joined
    Jun 2018
    Posts
    3
    Location
    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
  •