Download a file via VBA. Resume downloads

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.

Leave a Reply

Your email address will not be published. Required fields are marked *