copy

Tuesday, 5 November 2013



Excel & VBA - Download Internet Files Automatically


Introduction



There are times that we have to download an enormous amount of files from an internet location, but the procedure needs substantial time to complete manually. Apart from the waste of time, it is quite annoying to click on every file and press the “Save File” button of your browser and repeat this procedure again and again until you download all the files. Without a doubt, for few files this is not a problem, but, what if you had to download 50 (or more) files? How much time are you willing to sacrifice to download all these files?

Until now I am sure that some of you might wonder if there is a way to automate this routine task and save some time. Well, I have some good news for you: Excel and VBA can help you avoid all this manual procedure. Below you will find a sample workbook, which takes as input the URLs of the files you want to download. Then, by just selecting the download folder and pressing the “Download Files” button, every file is being downloaded in the chosen folder.



VBA code



The code is based on URLDownloadToFile API function, which “downloads bits from the Internet and saves them to a file.” The use of this API function is quite straightforward. However, in the sample workbook, I have included some error handling if-clauses to avoid illegal characters and invalid file paths. The VBA code for the primary procedure is given below:

Option Explicit

'API function declaration for both 32 and 64bit Excel.
#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                                    (ByVal pCaller As Long, _
                                    ByVal szURL As String, _
                                    ByVal szFileName As String, _
                                    ByVal dwReserved As Long, _
                                    ByVal lpfnCB As Long) As Long
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                            (ByVal pCaller As Long, _
                            ByVal szURL As String, _
                            ByVal szFileName As String, _
                            ByVal dwReserved As Long, _
                            ByVal lpfnCB As Long) As Long
#End If
 
Sub DownloadFiles()
                    
    '--------------------------------------------------------------------------------------------------
    'The macro loops through all the URLs (column C) and downloads the files at the specified folder.
    'The characters after the last "/" of the URL string are used to create the file path.
    'If the file is downloaded successfully an OK will appear in column D (otherwise an ERROR value).
    'The code is based on API function URLDownloadToFile, which actually does all the work.
            
    'Written By:    Christos Samaras
    'Date:          02/11/2013
    'Last Update:   06/06/2015
    'E-mail:        xristos.samaras@gmail.com
    'Site:          http://www.myengineeringworld.net
    '--------------------------------------------------------------------------------------------------
    
    'Declaring the necessary variables.
    Dim sh                  As Worksheet
    Dim DownloadFolder      As String
    Dim LastRow             As Long
    Dim SpecialChar()       As String
    Dim SpecialCharFound    As Double
    Dim FilePath            As String
    Dim i                   As Long
    Dim j                   As Integer
    Dim Result              As Long
    Dim CountErrors         As Long
    
    'Disable screen flickering.
    Application.ScreenUpdating = False
    
    'Set the worksheet object to the desired sheet.
    Set sh = Sheets("Main")
    
    'An array with special characters that cannot be used for naming a file.
    SpecialChar() = Split("\ / : * ? " & Chr$(34) & " < > |", " ")
    
    'Find the last row.
     With sh
        .Activate
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    End With
    
    'Check if the download folder exists.
    DownloadFolder = sh.Range("B4")
    On Error Resume Next
    If Dir(DownloadFolder, vbDirectory) = vbNullString Then
        MsgBox "The folder's path is incorrect!", vbCritical, "Folder's Path Error"
        sh.Range("B4").Select
        Exit Sub
    End If
    On Error GoTo 0
               
    'Check if there is at least one URL.
    If LastRow < 8 Then
        MsgBox "You did't enter a single URL!", vbCritical, "No URL Error"
        sh.Range("C8").Select
        Exit Sub
    End If
    
    'Clear the results column.
    sh.Range("D8:D" & LastRow).ClearContents
    
    'Add the backslash if doesn't exist.
    If Right(DownloadFolder, 1) <> "\" Then
        DownloadFolder = DownloadFolder & "\"
    End If
    
    'Counting the number of files that will not be downloaded.
    CountErrors = 0
    
    'Save the internet files at the specified folder of your hard disk.
    On Error Resume Next
    For i = 8 To LastRow
        
        'Find the characters after the last "/" of the URL.
        With WorksheetFunction
            FilePath = Mid(sh.Cells(i, 3), .Find("*", .Substitute(sh.Cells(i, 3), "/", "*", Len(sh.Cells(i, 3)) - _
                        Len(.Substitute(sh.Cells(i, 3), "/", "")))) + 1, Len(sh.Cells(i, 3)))
        End With
        
        'Check if the file path contains a special/illegal character.
        For j = LBound(SpecialChar) To UBound(SpecialChar)
            SpecialCharFound = InStr(1, FilePath, SpecialChar(j), vbTextCompare)
            'If an illegal character is found substitute it with a "-" character.
            If SpecialCharFound > 0 Then
                FilePath = WorksheetFunction.Substitute(FilePath, SpecialChar(j), "-")
            End If
        Next j
        
        'Create the final file path.
        FilePath = DownloadFolder & FilePath
        
        'Check if the file path exceeds the maximum allowable characters.
        If Len(FilePath) > 255 Then
            sh.Cells(i, 4) = "ERROR"
            CountErrors = CountErrors + 1
        End If
        
        'If the file path is valid, save the file into the selected folder.
        If UCase(sh.Cells(i, 4)) <> "ERROR" Then
        
            'Try to download and save the file.
            Result = URLDownloadToFile(0, sh.Cells(i, 3), FilePath, 0, 0)
            
            'Check if the file downloaded successfully and exists.
            If Result = 0 And Not Dir(FilePath, vbDirectory) = vbNullString Then
                'Success!
                sh.Cells(i, 4) = "OK"
            Else
                'Error!
                sh.Cells(i, 4) = "ERROR"
                CountErrors = CountErrors + 1
            End If
            
        End If
        
    Next i
    On Error GoTo 0
    
    'Enable the screen.
    Application.ScreenUpdating = True
    
    'Inform the user that macro finished successfully or with errors.
    If CountErrors = 0 Then
        'Success!
        If LastRow - 7 = 1 Then
            MsgBox "The file was successfully downloaded!", vbInformation, "Done"
        Else
            MsgBox LastRow - 7 & " files were successfully downloaded!", vbInformation, "Done"
        End If
    Else
        'Error!
        If CountErrors = 1 Then
            MsgBox "There was an error with one of the files!", vbCritical, "Error"
        Else
            MsgBox "There was an error with " & CountErrors & " files!", vbCritical, "Error"
        End If
    End If
    
End Sub

Below is the VBA code of two auxiliary macros for showing the folder picker dialog and cleaning the main sheet to be reused.

Option Explicit
    
 '---------------------------------------------------
 'This module contains some auxiliary subs.

 'Written By:    Christos Samaras
 'Date:          02/11/2013
 'Last Update:   06/06/2015
 'E-mail:        xristos.samaras@gmail.com
 'Site:          http://www.myengineeringworld.net
 '---------------------------------------------------
    
Sub FolderSelection()
    
    'Shows the folder picker dialog in order the user to select the folder
    'in which the downloaded files will be saved.
    
    Dim FoldersPath     As String
    
    'Show the folder picker dialog.
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a folder to save your files..."
        .Show
        If .SelectedItems.Count = 0 Then
            Sheets("Main").Range("B4") = "-"
            MsgBox "You did't select a folder!", vbExclamation, "Canceled"
            Exit Sub
        Else
            FoldersPath = .SelectedItems(1)
        End If
    End With
    
    'Pass the folder's path to the cell.
    Sheets("Main").Range("B4") = FoldersPath
    
End Sub

Sub Clear()
    
    'Clears the URLs, the result column and the folder's path.
            
    Dim LastRow     As Long
       
    'Find the last row.
     With Sheets("Main")
        .Activate
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    End With
    
    'Clear the ranges.
    If LastRow > 7 Then
        With Sheets("Main")
            .Range("C8:D" & LastRow).ClearContents
            .Range("B4:D4").ClearContents
            .Range("B4").Select
        End With
    End If
    
End Sub

Note that if you try to download large files, or your internet connection is slow the workbook, it might take some time to complete the download. However, in any case, the message box at the end of the procedure will inform you that the downloading has finished.



Demonstration video



The short video below shows how the sample workbook is used to download two files from Dropbox.




Update - 28/05/2014



Download Internet Files Automatically - User-Defined File Names

Motivated form some emails that I received from various blog readers, I decided to develop another version of the sample workbook. As the above image shows, the updated version allows the user to define a file name for the downloaded file. In this way, the downloaded files will have more meaningful names, and the user doesn't have to rename them manually. However, apart from the file names, the user should also define and the file extensions: for example Test.pdf, Sample.zip, My Workbook.xlsm, etc., otherwise the downloaded files will not be recognized, and the user then will have to add the extensions manually. So, in column D of the workbook, add the desired file names WITH their extensions.

The VBA code of the new procedure follows:

Option Explicit

'API function declaration for both 32 and 64bit Excel.
#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                                    (ByVal pCaller As Long, _
                                    ByVal szURL As String, _
                                    ByVal szFileName As String, _
                                    ByVal dwReserved As Long, _
                                    ByVal lpfnCB As Long) As Long
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                            (ByVal pCaller As Long, _
                            ByVal szURL As String, _
                            ByVal szFileName As String, _
                            ByVal dwReserved As Long, _
                            ByVal lpfnCB As Long) As Long
#End If
 
Sub DownloadFiles()
                    
    '--------------------------------------------------------------------------------------------------
    'The macro loops through all the URLs (column C) and downloads the files at the specified folder.
    'The given file names (column D) are used to create the full path of the files.
    'If the file is downloaded successfully an OK will appear in column E (otherwise an ERROR value).
    'The code is based on API function URLDownloadToFile, which actually does all the work.
            
    'Written By:    Christos Samaras
    'Date:          28/05/2014
    'Last Update:   06/06/2015
    'E-mail:        xristos.samaras@gmail.com
    'Site:          http://www.myengineeringworld.net
    '--------------------------------------------------------------------------------------------------
    
    'Declaring the necessary variables.
    Dim sh                  As Worksheet
    Dim DownloadFolder      As String
    Dim LastRow             As Long
    Dim SpecialChar()       As String
    Dim SpecialCharFound    As Double
    Dim FilePath            As String
    Dim i                   As Long
    Dim j                   As Integer
    Dim Result              As Long
    Dim CountErrors         As Long
    
    'Disable screen flickering.
    Application.ScreenUpdating = False
    
    'Set the worksheet object to the desired sheet.
    Set sh = Sheets("Main")
    
    'An array with special characters that cannot be used for naming a file.
    SpecialChar() = Split("\ / : * ? " & Chr$(34) & " < > |", " ")
    
    'Find the last row.
     With sh
        .Activate
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    End With
    
    'Check if the download folder exists.
    DownloadFolder = sh.Range("B4")
    On Error Resume Next
    If Dir(DownloadFolder, vbDirectory) = vbNullString Then
        MsgBox "The folder's path is incorrect!", vbCritical, "Folder's Path Error"
        sh.Range("B4").Select
        Exit Sub
    End If
    On Error GoTo 0
               
    'Check if there is at least one URL.
    If LastRow < 8 Then
        MsgBox "You did't enter a single URL!", vbCritical, "No URL Error"
        sh.Range("C8").Select
        Exit Sub
    End If
    
    'Clear the results column.
    sh.Range("E8:E" & LastRow).ClearContents
    
    'Add the backslash if doesn't exist.
    If Right(DownloadFolder, 1) <> "\" Then
        DownloadFolder = DownloadFolder & "\"
    End If

    'Counting the number of files that will not be downloaded.
    CountErrors = 0
    
    'Save the internet files at the specified folder of your hard disk.
    On Error Resume Next
    For i = 8 To LastRow
    
        'Use the given file name.
        If Not sh.Cells(i, 4) = vbNullString Then
            
            'Get the given file name.
            FilePath = sh.Cells(i, 4)
            
            'Check if the file path contains a special/illegal character.
            For j = LBound(SpecialChar) To UBound(SpecialChar)
                SpecialCharFound = InStr(1, FilePath, SpecialChar(j), vbTextCompare)
                'If an illegal character is found substitute it with a "-" character.
                If SpecialCharFound > 0 Then
                    FilePath = WorksheetFunction.Substitute(FilePath, SpecialChar(j), "-")
                End If
            Next j
            
            'Create the final file path.
            FilePath = DownloadFolder & FilePath
            
            'Check if the file path exceeds the maximum allowable characters.
            If Len(FilePath) > 255 Then
                sh.Cells(i, 5) = "ERROR"
                CountErrors = CountErrors + 1
            End If
                
        Else
            'Empty file name.
            sh.Cells(i, 5) = "ERROR"
            CountErrors = CountErrors + 1
        End If
        
        'If the file path is valid, save the file into the selected folder.
        If UCase(sh.Cells(i, 5)) <> "ERROR" Then
        
            'Try to download and save the file.
            Result = URLDownloadToFile(0, sh.Cells(i, 3), FilePath, 0, 0)
            
            'Check if the file downloaded successfully and exists.
            If Result = 0 And Not Dir(FilePath, vbDirectory) = vbNullString Then
                'Success!
                sh.Cells(i, 5) = "OK"
            Else
                'Error!
                sh.Cells(i, 5) = "ERROR"
                CountErrors = CountErrors + 1
            End If
            
        End If
        
    Next i
    On Error GoTo 0
    
    'Enable the screen.
    Application.ScreenUpdating = True
    
    'Inform the user that macro finished successfully or with errors.
    If CountErrors = 0 Then
        'Success!
        If LastRow - 7 = 1 Then
            MsgBox "The file was successfully downloaded!", vbInformation, "Done"
        Else
            MsgBox LastRow - 7 & " files were successfully downloaded!", vbInformation, "Done"
        End If
    Else
        'Error!
        If CountErrors = 1 Then
            MsgBox "There was an error with one of the files!", vbCritical, "Error"
        Else
            MsgBox "There was an error with " & CountErrors & " files!", vbCritical, "Error"
        End If
    End If
    
End Sub

I hope that the updated version will be more convenient for your downloads.



Downloads



Download

The zip file contains both versions of the sample workbook (both the old and the updated one). The files can be opened with Excel 2007 or newer. Please enable macros before using them.



Read also



Get External Hyperlinks From A Webpage

Did you like this post? If yes, then share it with your friends. Thank you!


Categories:


Mechanical Engineer (Ph.D. cand.), M.Sc. Cranfield University, Dipl.-Ing. Aristotle University, Thessaloniki - Greece.
Communication: e-mail, Facebook, Twitter, Google+ and Linkedin. More info