I'm modifying code to download multiple files via Excel VBA. The code is as 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 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: https://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("Sheet1")
'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"
sh.Cells(i, 2) = "ERROR1"
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"
sh.Cells(i, 2) = Result & "&" & FilePath & "&" & vbDirectory
Else
'Error!
sh.Cells(i, 4) = "ERROR"
sh.Cells(i, 2) = Result & "&" & FilePath & "&" & vbDirectory
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
This code downloads most files just fine, but I ran across issues when trying to download from SPP(Southwest Power Pool)'s API. For Example:
This file or any similar file that I try to download from this api is identified and downloaded just fine by any browser or download manager, but URLDownloadToFile reports an error and does not download the file. It downloads files from other sources successfully
My knowledge of coding allowed me to track down the error/return code, which is reported in column B by the following bit of code:
sh.Cells(i, 2) = Result & "&" & FilePath & "&" & vbDirectory
To my understanding, this indicates INET_E_SECURITY_PROBLEM with return code of -2146697202.
Beyond Identifying the error, I am out of my depth.
Assistance in figuring out how to get past this major roadblock would be greatly appreciated.
