Downloading multiple files from Internet

abhay_547 · 09-19-2010, 08:10 AM

Hi All,

I got the below code, from this site which downloads only one file at one go. I want the macro which will download multiple files from a list of links reflecting in a list box. I have created a userform which has a listbox which gets populated with all download links from where I want to download files. I need the help to implement the below code into my attached download tool userform.

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
  
Sub DownloadFilefromWeb()

  Const E_OUTOFMEMORY As Long = &H8007000E
  Const E_DOWNLOAD_FAILURE As Long = &H800C0002
  
  Dim InitialName As String
  Dim Msg As String
  Dim RegExp As Object
  Dim RetVal As Long
  Dim SaveName As String
  Dim SavePath As String
  Dim URL As String
  
    URL = InputBox("Enter the download URL below.", "Download from Internet")
    If URL = "" Then Exit Sub
    
    Set RegExp = CreateObject("VBScript.RegExp")
      RegExp.IgnoreCase = True
      RegExp.Pattern = "^(.*\/)(.+)$"
      InitialName = RegExp.Replace(URL, "$2")
    Set RegExp = Nothing
      
    If InitialName = "" Or InitialName = URL Then
      MsgBox "Error - Missing File Name"
      Exit Sub
    End If

    SavePath = Application.GetSaveAsFilename(InitialName)
    If SavePath = "" Then Exit Sub
    
    RetVal = URLDownloadToFile(0&, URL, SavePath, 0&, 0&)

    Select Case RetVal
      Case 0
        Msg = "Download Successful"
      Case E_OUTOFMEMORY
        Msg = "Error - Out of Mmemory"
      Case E_DOWNLOAD_FAILURE
        Msg = "Error - Bad URL or Connection Interrupted"
      Case Else
        Msg = "Unknown Error - " & RetVal
    End Select
    
    MsgBox Msg
    
End Sub

Thanks for your help in advance.

**TMS** · 09-19-2010, 03:35 PM

Make this a Global variable by moving it above all the code, that is, outside the routine.

Dim URL As String

Remove this line:

URL = InputBox("Enter the download URL below.", "Download from Internet")

Then, having populated your form and selected the files to be downloaded, loop through the list, putting each one in the URL variable and calling the DownloadFilefromWeb subroutine.

Regards

**Leith Ross** · 09-19-2010, 04:11 PM

Hello abhay_547,

Thought I recognized that code. I changed the download macro to Function to allow the URL and destination folder to be passed into the download loop. CommandButton5 now loops through URL and will display an error message if not successful. Also, a check is made that the destination folder has been selected. CommandButton2 has been updated to remove entries. All these changes are in the attached workbook.

Module1 - Amended Download Macro

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 DownloadFilefromWeb(ByVal URL As String, ByVal SavePath As String) As Variant

  Const E_OUTOFMEMORY As Long = &H8007000E
  Const E_DOWNLOAD_FAILURE As Long = &H800C0002
  Const E_INVALID_LINK As Long = &H800C000D
  
  Dim InitialName As String
  Dim Msg As String
  Dim RegExp As Object
  Dim RetVal As Long
  
    If URL = "" Or SavePath = "" Then Exit Function
    
    Set RegExp = CreateObject("VBScript.RegExp")
      RegExp.IgnoreCase = True
      RegExp.Pattern = "^(.*\/)(.+)$"
      InitialName = RegExp.Replace(URL, "$2")
    Set RegExp = Nothing
      
    If InitialName = "" Or InitialName = URL Then
      MsgBox "Error - Missing File Name"
      Exit Function
    End If
    
    RetVal = URLDownloadToFile(0&, URL, SavePath, 0&, 0&)

    Select Case RetVal
      Case 0
        DownloadFilefromWeb = True
      Case E_OUTOFMEMORY
        DownloadFilefromWeb = URL & vbCrLf & "Error - Out of Memory"
      Case E_DOWNLOAD_FAILURE
        DownloadFilefromWeb = URL & vbCrLf & "Error - Bad URL or Connection Interrupted"
      Case E_INVALID_LINK
        DownloadFilefromWeb = URL & vbCrLf & "Error - Invalid Link or Protocol Not Supported"
      Case Else
        DownloadFilefromWeb = URL & vbCrLf & "Error - Unknown = " & Hex(RetVal)
    End Select
    
End Function

frmdownload CommandButton2 and CommandButton5 Macro Code

Private Sub CommandButton2_Click()
 'REMOVE SELECTION
 
  Dim I As Long
 
    With ListBox1
      For I = .ListCount - 1 To 0 Step -1
        If .Selected(I) Then
           .RemoveItem .ListIndex
        End If
      Next I
    End With

End Sub

Private Sub CommandButton5_Click()
 'DOWNLOAD FILE
 
  Dim I As Integer
  Dim Ret As Variant
  
    If TextBox1.Value = "" Then MsgBox "Please select a folder.": Exit Sub
    
    For I = 0 To ListBox1.ListCount - 1
      If ListBox1.Selected(I) Then
         Ret = DownloadFilefromWeb(ListBox1.List(I), TextBox1.Value)
         If VarType(Ret) <> vbBoolean Then
            MsgBox Ret
         End If
      End If
    Next I
    
End Sub

abhay_547 · 10-02-2010, 07:43 AM

Hi Ross,

Thanks a lot for your reply, I tried to download some files using the revised version of download tool which you had attached with your earlier post. However the same is not working I am not sure why it's not working because the links which i am using are valid links but still shows error for each link and doesn't download any thing. It loops through each link reflecting in the listbox and shows error for each link though the links are working links. Attached is the file with the working links. Please help..

Thanks a lot for your help in advance.

**Leith Ross** · 10-02-2010, 05:21 PM

Hello abhay_547,

My apologies for not catching that problem. In the original test, I had added a new file name to the directory path. We will need to work out how to name the files. In the meantime, here is the updated macro for downloading a file from the web. There is an extra argument for the new file's name.

Function DownloadFilefromWeb(ByVal URL As String, ByVal SavePath As String, ByVal NewFileName As String) As Variant

  Const E_OUTOFMEMORY As Long = &H8007000E
  Const E_DOWNLOAD_FAILURE As Long = &H800C0002
  Const E_INVALID_LINK As Long = &H800C000D
  
  Dim InitialName As String
  Dim Msg As String
  Dim NewFileName As String
  Dim RegExp As Object
  Dim RetVal As Long
  
    If URL = "" Or SavePath = "" Then Exit Function
    
    If NewFileName = "" Then
       NewFileName = InputBox("Please enter a name for the file and it's extension.")
       If NewFileName = "" Then Exit Function
    End If
    
    Set RegExp = CreateObject("VBScript.RegExp")
      RegExp.IgnoreCase = True
      RegExp.Pattern = "^(.*\/)(.+)$"
      InitialName = RegExp.Replace(URL, "$2")
    Set RegExp = Nothing
      
    If InitialName = "" Or InitialName = URL Then
      MsgBox "Error - Missing File Name"
      Exit Function
    End If
    
    RetVal = URLDownloadToFile(0&, URL, SavePath & NewFileName, 0&, 0&)

    Select Case RetVal
      Case 0
        DownloadFilefromWeb = True
      Case E_OUTOFMEMORY
        DownloadFilefromWeb = URL & vbCrLf & "Error - Out of Memory"
      Case E_DOWNLOAD_FAILURE
        DownloadFilefromWeb = URL & vbCrLf & "Error - Bad URL or Connection Interrupted"
      Case E_INVALID_LINK
        DownloadFilefromWeb = URL & vbCrLf & "Error - Invalid Link or Protocol Not Supported"
      Case Else
        DownloadFilefromWeb = URL & vbCrLf & "Error - Unknown = " & Hex(RetVal)
    End Select
    
End Function

abhay_547 · 10-03-2010, 04:03 AM

Hi Ross,

Thanks a lot for your reply, I had incorporated the code provided by you in your earlier post in my download tool macro but it is showing an compile error. Attached is my download tool macro file for your reference.

Apart from this I have identified one more issue in my macro .i.e. when I try to remove a URL from the listbox by selecting the same and clicking on remove button it gets only removed from the listbox but not from the excel sheet. It should ideally remove the selected listbox item from excel sheet as well and should ask first before removing the item from the listbox .i.e. a confirmation from user with a prompt .i.e. "Are you sure you want to remove this item".

I have got the below code from the extensive google search for deleting items from listbox (which will also delete the items from excel sheet but some how when I am trying to incorporate the below code in my macro it doesn't work. Please help.

Private Sub cmdDel_Click()

With UserForm1.ListBox1
    'Check for selected item
    If (.Value <> vbNullString) Then
    
        'If more then one data rows
        If (.ListIndex >= 0 And xlLastRow("Sheet1") > 2) Then
            Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
            'Update listbox
            .RowSource = "Sheet1!A2:C" & xlLastRow("Sheet1")
            
        'If only one data row
        ElseIf (.ListIndex = 0 And xlLastRow("Sheet1") = 2) Then
            Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
            'Update listbox
            .RowSource = "Sheet1!A2:C2"
        End If
    Else
        MsgBox "Please Select Data"
        
    End If
End With

End Sub

Apart from this I want to rename the downloaded files as per the names present against each link in the column B.

Thanks a lot for your help in advance.

**Leith Ross** · 10-03-2010, 02:35 PM

Hello abhay_547,

I changed the macro to use columns "B" and "C" for the new file name and file type. I also added a status bar on the download form. Have a look at the attached workbook and let me know how if any changes need to be made.