Vba Download File From Url With Password
Introduction
There are times that we have to download an enormous amount of files from an net location, but the process needs substantial time to complete manually. Apart from wasting fourth dimension, it is quite annoying to click on every file and press the "Relieve File" button of your browser and repeat this procedure again and over again until you download all the files. Without a doubt, for few files, this is not a problem, only what if you had to download l (or more) files? How much time are you willing to cede to download all these files?
Until now, I am sure that some of yous might wonder if there is a way to automate this routine task and relieve some time. Well, I accept some adept news for you: Excel and VBA can assist you lot avoid this transmission process. Below you lot will notice a sample workbook, which takes as input the URLs of the files you want to download. Then, by just selecting the download binder and pressing the "Download Files" push, every file is downloaded in the chosen folder.
VBA code
The code is based on the URLDownloadToFile function, which "downloads bits from the Net and saves them to a file." The use of this API function is quite straightforward. However, in the sample workbook, I take included some mistake treatment if-clauses to avoid illegal characters and invalid file paths. The VBA code for the chief procedure is given below:
Option Explicit 'API function annunciation 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 Every bit Long) Equally Long #Else Private Declare Part URLDownloadToFile Lib "urlmon" Allonym "URLDownloadToFileA" _ (ByVal pCaller As Long, _ ByVal szURL As String, _ ByVal szFileName As Cord, _ 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 final "/" 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 Fault 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-postal service: [electronic mail protected] 'Site: http://www.myengineeringworld.cyberspace '-------------------------------------------------------------------------------------------------- 'Declaring the necessary variables. Dim sh Equally Worksheet Dim DownloadFolder As Cord Dim LastRow Equally Long Dim SpecialChar() As Cord Dim SpecialCharFound As Double Dim FilePath As String Dim i As Long Dim j As Integer Dim Result As Long Dim CountErrors Equally Long 'Disable screen flickering. Application.ScreenUpdating = Imitation 'Set the worksheet object to the desired sheet. Gear up sh = Sheets("Main") 'An array with special characters that cannot be used for naming a file. SpecialChar() = Split up("\ / : * ? " & Chr$(34) & " < > |", " ") 'Observe the final row. With sh .Activate LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row End With 'Cheque 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 Fault GoTo 0 'Check if at that place is at least ane URL. If LastRow < 8 So MsgBox "You did't enter a single URL!", vbCritical, "No URL Error" sh.Range("C8").Select Get out Sub End If 'Clear the results column. sh.Range("D8:D" & LastRow).ClearContents 'Add the backslash if doesn't exist. If Right(DownloadFolder, 1) <> "\" And so DownloadFolder = DownloadFolder & "\" Finish If 'Counting the number of files that will not exist downloaded. CountErrors = 0 'Salvage the internet files at the specified binder of your hard disk. On Error Resume Next For i = 8 To LastRow 'Find the characters later on the terminal "/" 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, three))) 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 grapheme is found substitute it with a "-" graphic symbol. If SpecialCharFound > 0 So FilePath = WorksheetFunction.Substitute(FilePath, SpecialChar(j), "-") Terminate If Next j 'Create the terminal file path. FilePath = DownloadFolder & FilePath 'Check if the file path exceeds the maximum commanded characters. If Len(FilePath) > 255 Then sh.Cells(i, 4) = "Fault" CountErrors = CountErrors + 1 End If 'If the file path is valid, salve the file into the selected folder. If UCase(sh.Cells(i, iv)) <> "Mistake" And so 'Try to download and relieve the file. Outcome = 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 'Mistake! sh.Cells(i, iv) = "ERROR" CountErrors = CountErrors + i End If End If Next i On Mistake 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 And so MsgBox "The file was successfully downloaded!", vbInformation, "Done" Else MsgBox LastRow - 7 & " files were successfully downloaded!", vbInformation, "Done" End If Else 'Fault! If CountErrors = ane Then MsgBox "There was an error with one of the files!", vbCritical, "Error" Else MsgBox "There was an error with " & CountErrors & " files!", vbCritical, "Error" Stop If End If Cease Sub Below is the VBA code of 2 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 'Appointment: 02/11/2013 'Concluding Update: 06/06/2015 'E-mail: [e-mail protected] 'Site: http://www.myengineeringworld.net '--------------------------------------------------- Sub FolderSelection() 'Shows the binder picker dialog in lodge for the user to select the folder 'in which the downloaded files volition exist saved. Dim FoldersPath As String 'Show the binder picker dialog. With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Select a binder to salvage your files..." .Show If .SelectedItems.Count = 0 And so Sheets("Main").Range("B4") = "-" MsgBox "You did't select a folder!", vbExclamation, "Canceled" Go out Sub Else FoldersPath = .SelectedItems(1) End If Stop With 'Pass the folder's path to the jail cell. Sheets("Main").Range("B4") = FoldersPath End Sub Sub Clear() 'Clears the URLs, the event column and the folder'due south path. Dim LastRow Every bit Long 'Find the last row. With Sheets("Main") .Actuate LastRow = .Cells(.Rows.Count, "C").Cease(xlUp).Row End With 'Clear the ranges. If LastRow > 7 Then With Sheets("Principal") .Range("C8:D" & LastRow).ClearContents .Range("B4:D4").ClearContents .Range("B4").Select End With Terminate If Terminate Sub Note that if y'all endeavour to download large files or your cyberspace connexion is slow, the workbook might have some time to complete the download. Withal, in any case, the bulletin box at the end of the procedure will inform you lot that the downloading has finished.
Sit-in video
The short video beneath shows how the sample workbook is used to download ii files from Dropbox.
Update – May 28, 2014
Motivated by 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 manner, the downloaded files volition have more meaningful names, and the user doesn't have to rename them manually. However, apart from the file names, the user should besides define and the file extensions; for example, Examination.pdf, Sample.cypher, My Workbook.xlsm, etc., otherwise the downloaded files will not be recognized. The user then will have to add the extensions manually. Then, in cavalcade D of the workbook, add the desired file names WITH their extensions.
The VBA code of the new procedure follows:
Option Explicit 'API function annunciation for both 32 and 64bit Excel. #If VBA7 Then Individual Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller Every bit Long, _ ByVal szURL As String, _ ByVal szFileName As String, _ ByVal dwReserved As Long, _ ByVal lpfnCB As Long) Every bit Long #Else Private Declare Function URLDownloadToFile Lib "urlmon" Allonym "URLDownloadToFileA" _ (ByVal pCaller As Long, _ ByVal szURL As Cord, _ ByVal szFileName Equally String, _ ByVal dwReserved As Long, _ ByVal lpfnCB As Long) As Long #End If Sub DownloadFiles() '-------------------------------------------------------------------------------------------------- 'The macro loops through all the URLs (cavalcade C) and downloads the files at the specified binder. 'The given file names (column D) are used to create the full path of the files. 'If the file is downloaded successfully an OK volition appear in column E (otherwise an ERROR value). 'The code is based on API function URLDownloadToFile, which actually does all the work. 'Written Past: Christos Samaras 'Date: 28/05/2014 'Last Update: 06/06/2015 'E-post: [e-mail protected] 'Site: http://www.myengineeringworld.cyberspace '-------------------------------------------------------------------------------------------------- 'Declaring the necessary variables. Dim sh Every bit Worksheet Dim DownloadFolder Every bit Cord Dim LastRow Every bit Long Dim SpecialChar() As String Dim SpecialCharFound As Double Dim FilePath As Cord Dim i Equally Long Dim j Equally Integer Dim Outcome Equally Long Dim CountErrors Every bit Long 'Disable screen flickering. Application.ScreenUpdating = Imitation 'Fix the worksheet object to the desired canvass. Set sh = Sheets("Master") '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").Cease(xlUp).Row End With 'Bank check if the download folder exists. DownloadFolder = sh.Range("B4") On Error Resume Side by side If Dir(DownloadFolder, vbDirectory) = vbNullString And so MsgBox "The folder's path is incorrect!", vbCritical, "Folder's Path Error" sh.Range("B4").Select Exit Sub Finish If On Error GoTo 0 'Cheque if there is at least one URL. If LastRow < 8 Then MsgBox "You lot did't enter a unmarried URL!", vbCritical, "No URL Fault" sh.Range("C8").Select Get out Sub End If 'Clear the results column. sh.Range("E8:E" & LastRow).ClearContents 'Add together the backslash if doesn't exist. If Correct(DownloadFolder, 1) <> "\" So DownloadFolder = DownloadFolder & "\" Finish If 'Counting the number of files that will not exist downloaded. CountErrors = 0 'Save the internet files at the specified binder of your hard disk drive. On Error Resume Next For i = viii To LastRow 'Use the given file name. If Not sh.Cells(i, 4) = vbNullString And then 'Get the given file proper noun. FilePath = sh.Cells(i, four) 'Check if the file path contains a special/illegal character. For j = LBound(SpecialChar) To UBound(SpecialChar) SpecialCharFound = InStr(one, FilePath, SpecialChar(j), vbTextCompare) 'If an illegal character is found substitute it with a "-" character. If SpecialCharFound > 0 So FilePath = WorksheetFunction.Substitute(FilePath, SpecialChar(j), "-") Cease If Adjacent j 'Create the final file path. FilePath = DownloadFolder & FilePath 'Check if the file path exceeds the maximum allowable characters. If Len(FilePath) > 255 And so sh.Cells(i, 5) = "ERROR" CountErrors = CountErrors + 1 Finish If Else 'Empty file proper name. sh.Cells(i, 5) = "ERROR" CountErrors = CountErrors + one 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. Consequence = 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 And then 'Success! sh.Cells(i, five) = "OK" Else 'Fault! sh.Cells(i, 5) = "ERROR" CountErrors = CountErrors + 1 End If Terminate 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 And so 'Success! If LastRow - 7 = 1 Then MsgBox "The file was successfully downloaded!", vbInformation, "Washed" Else MsgBox LastRow - 7 & " files were successfully downloaded!", vbInformation, "Done" End If Else 'Error! If CountErrors = one Then MsgBox "There was an mistake with one of the files!", vbCritical, "Mistake" Else MsgBox "There was an error with " & CountErrors & " files!", vbCritical, "Error" Terminate If Cease If End Sub I hope that the updated version volition exist more convenient for your downloads.
Downloads
The zip file contains both workbook versions (the one-time and the updated ones). The files can be opened with Excel 2007 or newer. Please enable macros before using them.
Read also
Become External Hyperlinks From A Webpage
Go Image Size From A URL
Folio concluding modified: September 28, 2021
DOWNLOAD HERE
Posted by: hewlettwilcorts.blogspot.com
0 Komentar
Post a Comment