I’ve tried several ways to download a file, but none of them were truly convincing me, beeing the most promissing the URLDownloadToFile API function. But recently I found a post on the AnalystCave that rely on the InternetReadBinaryFile
The use of this API functions got me thinking if I can control the download progress (for example, to resume a broken download, or throw it to perform on VBscript). The VBS option comes really handy, as can free Excel of the downloading process, and doesn’t require an InternetExplorer object, so it can be used also as a method to overcome ban situations and continue downloading.
The lNumBytesToRead in the InternetReadBinaryFile function was very promissing, but did not manage to tame it to my requirements, so it looks like to resume a download will not be achieved via API functions. Anyway, googling a bit shows me that it could be done via XMLHTTP request (you had to tune the Range attribute… worth looking here, here and here)
There’s another option to download files described here.
And following, the code that achieves the download resume:
Private Sub ResumeDownload(ByVal strURL As String, _
ByVal sSaveToFile As String, _
Optional ByVal overWriteFile As Boolean = False, _
Optional ByVal lgFirstByteToRead As Long = 0, _
Optional ByVal lgBytesToRead As Long = 0)
Dim oHTTP As Object
Dim oStream As Object
Dim sBuffer() As Byte
Dim totalRead As Long
'Const bufSize = 128
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
With oHTTP
.Open "GET", strURL, False
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.setRequestHeader "Range", VBA.CStr("bytes=" & lgFirstByteToRead & "-" & VBA.IIf(lgBytesToRead = 0, "", lgFirstByteToRead + lgBytesToRead)) ' retrieve only this bytes...
.send ("")
'wait
Do While .Status = 200 And .readyState = 4
DoEvents
Loop
If lgBytesToRead = 0 Then lgBytesToRead = VBA.Len(.responsetext)
ReDim sBuffer(0 To lgBytesToRead - 1)
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
'Do
' lgRetVal = InternetReadBinaryFile(hInternet, sBuffer(0), UBound(sBuffer) - LBound(sBuffer), lngDataReturned)
' If lngDataReturned = 0 Then Exit Do
'
' If lngDataReturned < bufSize Then ReDim Preserve sBuffer(0 To lngDataReturned - 1)
oStream.Write sBuffer
' ReDim sBuffer(0 To bufSize - 1)
' totalRead = totalRead + lngDataReturned
' 'Application.StatusBar = "Downloading file. " & CLng(100 * totalRead / bufSize) & "% of " & totalRead & " KB downloaded"
' DoEvents
'Loop While lngDataReturned <> 0
'Application.StatusBar = "Download complete"
oStream.SaveToFile sSaveToFile, IIf(overWriteFile, 2, 1)
oStream.Close
Dim iFileOut As Integer
iFileOut = VBA.FreeFile()
Open sSaveToFile For Binary As #iFileOut
Put #iFileOut, , VBA.StrConv(.responsetext, vbFromUnicode)
Close #iFileOut
End With
End Sub
For the API methods, both discussed are shown here, activate the one you whish to try:
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Option Explicit
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const DOWNLOAD_OK As Long = 0
'Private Const E_OUTOFMEMORY As Long = &H8007000E
'Private Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0
'Private Const INTERNET_FLAG_EXISTING_CONNECT As Long = &H20000000
'Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
'Private Const INTERNET_OPEN_TYPE_PROXY As Long = 3
'Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadBinaryFile Lib "wininet.dll" Alias "InternetReadFile" (ByVal hfile As Long, ByRef bytearray_firstelement As Byte, ByVal lNumBytesToRead As Long, ByRef lNumberOfBytesRead As Long) As Integer
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
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Sub TestDownload()
Dim strPath As String
strPath = VBA.Environ$("UserProfile") & "\Documents\" 'ThisWorkbook.Path
'DownloadFile "https://analystcave.com/junk.txt", strPath & "junk.txt", True
DownloadFile "https://www.planwallpaper.com/static/cache/76/ae/76aef16c40b4e4447233badc50b1845a.jpg", strPath & "image_https_2.jpg"
End Sub
Sub DownloadFile(ByVal sUrl As String, _
ByVal sSaveToFile As String, _
Optional ByVal overWriteFile As Boolean = False)
Dim oStream As Object
Dim hInternet As Long
Dim hSession As Long
Dim lngDataReturned As Long
Dim sBuffer() As Byte
Dim totalRead As Long
Dim lgRetVal As Long
Stop ' Method URLDownloadToFile
'lgRetVal = URLDownloadToFile(0&, sUrl, sSaveToFile, 0&, 0)
'If lgRetVal = DOWNLOAD_OK Then Exit Sub ' download completed
Stop ' Method InternetReadBinaryFile
Const bufSize = 128
ReDim sBuffer(0 To bufSize - 1)
hSession = InternetOpen("", 0, vbNullString, vbNullString, 0)
If hSession Then
hInternet = InternetOpenUrl(hSession, sUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
End If
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
If hInternet Then
lngDataReturned = 0
Do
lgRetVal = InternetReadBinaryFile(hInternet, sBuffer(0), UBound(sBuffer) - LBound(sBuffer), lngDataReturned)
If lngDataReturned = 0 Then Exit Do
If lngDataReturned < bufSize Then ReDim Preserve sBuffer(0 To lngDataReturned - 1)
oStream.Write sBuffer()
ReDim sBuffer(0 To bufSize - 1)
totalRead = totalRead + lngDataReturned
Application.StatusBar = "Downloading file. " & CLng(100 * totalRead / bufSize) & "% of " & totalRead & " KB downloaded"
DoEvents
Loop While lngDataReturned <> 0
Application.StatusBar = "Download complete"
oStream.SaveToFile sSaveToFile, IIf(overWriteFile, 2, 1)
oStream.Close
End If
Call InternetCloseHandle(hInternet)
Set oStream = Nothing
End Sub
Also, dealing with downloads topic, I also liked this post.