Download a file with progress possible?

[ballgnm]

Hello folks.
I'm doing an excel file that needs to download a chromedriver.
I can't track the percentage of download process from filestream as it waits until it finishes to write.
Is there any way to get size of filestream as it's getting fetched from internet.

Well, chromedriver is only 6.8 MB so it's faster to download. I've tried with bigger files and still the same.

This is what I've tried.

Private Sub driverDownload(ByVal dVersion As String)
    Dim http As New MSXML2.XMLHTTP60
    Dim url As String
    Dim fileSize As Double
    Dim recieved As Double
    Dim fileStream As Object
  
    url = "https://chromedriver.storage.googleapis.com/" + dVersion + "/chromedriver_win32.zip"
    Set http = New MSXML2.XMLHTTP60
    http.Open "GET", url, False
    http.send
    recieved = 0
    If http.Status = 200 Then
  
        fileSize = mdlChromeDriver.http.getResponseHeader("Content-Length")
      
        Set fileStream = VBA.CreateObject("ADODB.Stream")
        fileStream.Open
        fileStream.Type = 1
        fileStream.Write http.responseBody
      
        Do While recieved < fileSize
            recieved = fileStream.Size
            Debug.Print "Downloading " & Round(recieved / fileSize * 100, 2) & " %"
            DoEvents
        Loop
      
        fileStream.SaveToFile Environ("USERPROFILE") & "\Desktop\chromedriver " & dVersion & ".zip", 2
        fileStream.Close
      
    End If
  
    Set http = Nothing
  
End Sub

 

[Jaafar Tribak]

Using WinHttpRequest, you can use the OnResponseDataAvailable event handler in a class module to show the file download progress.

You need to use early binding to tarp thee vents . So, in the VBE|Tools|references, add a reference to the WinHTPP Service COM library

This worked for me:

1- Add a new class module to your vba project and give the class the name of CChromeDriverDownloadder

Place the code below in the class module:

Option Explicit

'Project requires a reference to the WinHTPP Service COM library.

Private WithEvents http As WinHttpRequest
Private lProgress As Long, lContentLength As Long
Private sVersion As String, sSaveToFilePath As String

Public Sub ChromedriverDownload( _
    ByVal url As String, _
    ByVal dVersion As String, _
    ByVal SavePath As String _
)
    sSaveToFilePath = SavePath: sVersion = dVersion
    Set http = New WinHttpRequest
    http.Open "GET", url + dVersion + "/chromedriver_win32.zip", True
    http.send
    DoEvents

End Sub

Private Sub http_OnResponseStart(ByVal Status As Long, ByVal ContentType As String)
    lProgress = 0&
    lContentLength = CLng(http.getResponseHeader("Content-Length"))
    Open sSaveToFilePath + "\chromedriver" + sVersion & ".zip" For Binary As #1
End Sub

Private Sub http_OnResponseDataAvailable(Data() As Byte)
    lProgress = lProgress + UBound(Data) + 1&
    'Show file download progress ..
    Debug.Print "Downloading " & Round(lProgress / lContentLength * 100&, 2&) & " %"
    Put #1, , Data
End Sub

Private Sub http_OnResponseFinished()
    Close #1
    MsgBox "Done."
End Sub

2- Code Usage test in a standard module:

Option Explicit

Private oCChDrv As CChromeDriverDownloadder

Sub Test()
    Set oCChDrv = New CChromeDriverDownloadder
    oCChDrv.ChromedriverDownload _
            url:="https://chromedriver.storage.googleapis.com/", _
            dVersion:="110.0.5481.77", _
            SavePath:=ThisWorkbook.Path
End Sub

 

[ballgnm]

This worked for me:

Really nice. I surfed through stackoverflow and forums for several days and couldn't find working solution.
But how can I make its progress displayed on userform?

 

[Jaafar Tribak]

Really nice. I surfed through stackoverflow and forums for several days and couldn't find working solution.
But how can I make its progress displayed on userform?

Hi ballgnm

Here is an example where we can show the download progress in a userform progressbar... The fake progress bar is made with labels and is created @ runtime to look like and behave like a seperate component. The Progress bar automatically carries with it an Abort button as well.


File Demo:
ChromeDriverDownloader_UserForm.xlsm

Note that the actual ProgressBar looks better... For some reason, the demo GIF below breaks the progress bar rendering and smudges the image.






UserForm Module Code:

Option Explicit

'Project requires a reference to the Microsoft WinHTPP Service COM library.
Private WithEvents http As WinHttpRequest
Private WithEvents oCAbortButton As MSForms.CommandButton
Private oProgressBar As MSForms.Label

Private lProgress As Long, lContentLength As Long
Private sVersion As String, sSaveToFilePath As String
Private iFreeFile As Integer

Private Sub UserForm_Initialize()
    With ComboBox1
        .List = GetDriverVersions
        .Value = .List(0&)
    End With
    With CommandButton1
        Set oProgressBar = CreateProgressBar( _
                           15&, .Top + .Height + 20&, Me.InsideWidth - 30&, 15&)
    End With
End Sub

Private Sub UserForm_Terminate()
    If Not http Is Nothing Then
        http.Abort
    End If
End Sub

Private Sub UserForm_AddControl(ByVal Control As MSForms.Control)
    If TypeOf Control Is MSForms.CommandButton Then
        Set oCAbortButton = Control
    End If
End Sub

Private Sub oCAbortButton_Click()
    http.Abort
    ShowProgressBar , False
    CommandButton1.Enabled = True
    Me.Height = Me.Height - 50&
    MsgBox "Oops!" & vbLf & vbLf & "Download operation aborted.", vbExclamation, "Cancelled!"
End Sub

Private Sub CommandButton1_Click()
    Me.Height = Me.Height + 50&
    CommandButton1.Enabled = False
    Call ChromedriverDownload( _
        url:="https://chromedriver.storage.googleapis.com/", _
        dVersion:=Me.ComboBox1.Value, _
        SavePath:=ThisWorkbook.Path _
    )
End Sub

Private Sub ChromedriverDownload( _
    ByVal url As String, _
    ByVal dVersion As String, _
    ByVal SavePath As String _
)
    sSaveToFilePath = SavePath: sVersion = dVersion
    Set http = New WinHttpRequest
    http.Open "GET", url + dVersion + "/chromedriver_win32.zip", True
    http.send
    DoEvents
End Sub

Private Sub http_OnResponseStart(ByVal Status As Long, ByVal ContentType As String)
    lProgress = 0&
    lContentLength = CLng(http.getResponseHeader("Content-Length"))
    iFreeFile = FreeFile()
    Open sSaveToFilePath + "\chromedriver" + sVersion & ".zip" For Binary As #iFreeFile
End Sub

Private Sub http_OnResponseDataAvailable(Data() As Byte)
    lProgress = lProgress + UBound(Data) + 1&
    'Show file download progress
    Call ShowProgressBar(Round(lProgress / lContentLength, 2&), True)
    On Error Resume Next
    Put #iFreeFile, , Data
End Sub

Private Sub http_OnResponseFinished()
    Close #iFreeFile
    Call ShowProgressBar(, False)
    CommandButton1.Enabled = True
    Me.Height = Me.Height - 50&
    MsgBox "The file: '" + sSaveToFilePath + "\chromedriver" + sVersion + ".zip'" + _
           " was successfully saved.", vbInformation, "Done!"
End Sub

Private Function CreateProgressBar( _
    ByVal X As Single, _
    ByVal Y As Single, _
    ByVal W As Single, _
    ByVal H As Single _
) As Object

    With Controls.Add("Forms.Label.1", "Back", False)
        .Width = W
        .Height = H
        .Top = Y
        .Left = X
        .BackColor = &HC0FFC0
        .BorderStyle = fmBorderStyleSingle
    End With
    With Controls.Add("Forms.Label.1", "Progress", False)
        .Width = 100&
        .Height = 10&
        .Top = Me.Controls("Back").Top - 12&
        .Left = X
    End With
    With Controls.Add("Forms.CommandButton.1", "Abort", False)
        .Width = 40&
        .Height = 20&
        .Top = Me.Controls("Back").Top + Me.Controls("Back").Height + 2
        .Left = X
        .Caption = "Abort"
        .Accelerator = "A"
        .BackColor = &HC0FFC0
    End With
    With Controls.Add("Forms.Label.1", "Fore", False)
        .Width = 0&
        .Height = H - 2&
        .Top = Y + 1&
        .Left = X + 1&
        .Caption = ""
        .BackColor = vbGreen
        .ZOrder 0&
        Set CreateProgressBar = Me.Controls("Fore")
    End With
End Function

Public Sub ShowProgressBar(Optional ByVal Progress As Single, Optional ByVal bShow As Boolean = True)
    Dim objBack As MSForms.Label
    Dim objFore As MSForms.Label
    Dim oProgress As MSForms.Label
    Dim objAbort As MSForms.CommandButton
   
    Set objBack = Me.Controls("Back")
    Set objFore = Me.Controls("Fore")
    Set oProgress = Me.Controls("Progress")
    Set objAbort = Me.Controls("Abort")
    objBack.Visible = bShow
    objFore.Visible = bShow
    oProgress.Visible = bShow
    objAbort.Visible = bShow
    If bShow Then
        objFore.Width = objBack.Width * Progress
        oProgress.Caption = "Downloading " & Round(Progress * 100&, 2&) & " %"
    End If
End Sub

Private Function GetDriverVersions() As Variant()
    GetDriverVersions = Array( _
        "114.0.5735.90", _
        "114.0.5735.16", _
        "113.0.5672.63", _
        "113.0.5672.24", _
        "112.0.5615.49", _
        "112.0.5615.28", _
        "111.0.5563.64", _
        "111.0.5563.41", _
        "111.0.5563.19", _
        "110.0.5481.77", _
        "110.0.5481.30", _
        "109.0.5414.74", _
        "109.0.5414.25", _
        "108.0.5359.71", _
        "108.0.5359.22", _
        "107.0.5304.62", _
        "107.0.5304.18", _
        "106.0.5249.61", _
        "106.0.5249.21", _
        "105.0.5195.52", _
        "105.0.5195.19", _
        "104.0.5112.79", _
        "104.0.5112.29" _
    )
End Function

 

[Jaafar Tribak]

UPDATE:
Bug fixed + added some error handling:

Updated File Demo:
ChromeDriverDownloader_UserForm.xlsm


Please, ignore the code in the previous post and use the following update:

In the UserForm Module:

Option Explicit

'Project requires a reference to the Microsoft WinHTPP Service COM library.
Private WithEvents http As WinHttpRequest
Private WithEvents oCAbortButton As MSForms.CommandButton
Private oProgressBar As MSForms.Label

Private lProgress As Long, lContentLength As Long
Private sFileUrl As String, sVersion As String, sSaveToFilePath As String
Private iFreeFile As Integer


Private Sub UserForm_Initialize()
    With ComboBox1
        .List = GetDriverVersions
        .Value = .List(0&)
    End With
    With CommandButton1
        Set oProgressBar = CreateProgressBar( _
                           15&, .Top + .Height + 20&, Me.InsideWidth - 30&, 15&)
    End With
End Sub

Private Sub UserForm_Terminate()
    If Not http Is Nothing Then
        http.Abort
    End If
    Close #iFreeFile
End Sub

Private Sub UserForm_AddControl(ByVal Control As MSForms.Control)
    If TypeOf Control Is MSForms.CommandButton Then
        Set oCAbortButton = Control
    End If
End Sub

Private Sub oCAbortButton_Click()
    http.Abort
    Close #iFreeFile
    Kill sSaveToFilePath + "\chromedriver" + sVersion + ".zip"
    ShowProgressBar , False
    CommandButton1.Enabled = True
    Me.Height = Me.Height - 50&
    MsgBox "Oops!" & vbLf & vbLf & "Download operation aborted.", vbExclamation, "Cancelled!"
End Sub

Private Sub CommandButton1_Click()
    Me.Height = Me.Height + 50&
    CommandButton1.Enabled = False
    Call ChromedriverDownload( _
        url:="https://chromedriver.storage.googleapis.com/", _
        dVersion:=Me.ComboBox1.Value, _
        SavePath:=ThisWorkbook.Path _
    )
End Sub

Private Sub ChromedriverDownload( _
    ByVal url As String, _
    ByVal dVersion As String, _
    ByVal SavePath As String _
)
    sSaveToFilePath = SavePath: sVersion = dVersion
    sFileUrl = url + dVersion + "/chromedriver_win32.zip"
    Set http = New WinHttpRequest
    http.Open "GET", sFileUrl, True
    http.send
End Sub

Private Sub http_OnResponseStart(ByVal Status As Long, ByVal ContentType As String)
    lProgress = 0&
    lContentLength = CLng(http.getResponseHeader("Content-Length"))
    iFreeFile = FreeFile()
    If Len(Dir(sSaveToFilePath, vbDirectory)) Then
        Open sSaveToFilePath + "\chromedriver" + sVersion + ".zip" For Binary As #iFreeFile
    Else
        http.Abort
        Close #iFreeFile
        ShowProgressBar , False
        Me.Height = Me.Height - 50&
        MsgBox "Save Path not valid.", vbExclamation
    End If
End Sub

Private Sub http_OnResponseDataAvailable(Data() As Byte)
    lProgress = lProgress + UBound(Data) + 1&
    'Show file download progress
    Call ShowProgressBar(Round(lProgress / lContentLength, 2&), True)
    On Error Resume Next
    Put #iFreeFile, , Data
End Sub

Private Sub http_OnResponseFinished()
    Close #iFreeFile
    If InStr(1&, http.ResponseText, "ERROR", vbTextCompare) Then
        Close #iFreeFile
        Kill sSaveToFilePath + "\chromedriver" + sVersion + ".zip"
        MsgBox "Download of " + vbLf + vbLf + sFileUrl _
               + vbLf + vbLf + "Failed!", vbCritical, "Error"
        GoTo Xit
    End If
    MsgBox "The file: '" + sSaveToFilePath + "\chromedriver" + sVersion + ".zip'" + _
           " was successfully saved.", vbInformation, "Done!"
Xit:
    Call ShowProgressBar(, False)
    CommandButton1.Enabled = True
    Me.Height = Me.Height - 50&
End Sub

Private Function CreateProgressBar( _
    ByVal X As Single, _
    ByVal Y As Single, _
    ByVal W As Single, _
    ByVal H As Single _
) As MSForms.Label

    With Controls.Add("Forms.Label.1", "Back", False)
        .Width = W
        .Height = H
        .Top = Y
        .Left = X
        .BackColor = &HC0FFC0
        .BorderStyle = fmBorderStyleSingle
    End With
    With Controls.Add("Forms.Label.1", "Progress", False)
        .Width = 100&
        .Height = 10&
        .Top = Me.Controls("Back").Top - 12&
        .Left = X
    End With
    With Controls.Add("Forms.CommandButton.1", "Abort", False)
        .Width = 40&
        .Height = 20&
        .Top = Me.Controls("Back").Top + Me.Controls("Back").Height + 2
        .Left = X
        .Caption = "Abort"
        .Accelerator = "A"
        .BackColor = &HC0FFC0
    End With
    With Controls.Add("Forms.Label.1", "Fore", False)
        .Width = 0&
        .Height = H - 1.8
        .Top = Y + 1&
        .Left = X + 1&
        .Caption = ""
        .BackColor = vbGreen
        .ZOrder 0&
        Set CreateProgressBar = Me.Controls("Fore")
    End With
End Function

Public Sub ShowProgressBar(Optional ByVal Progress As Single, Optional ByVal bShow As Boolean = True)
    Dim objBack As MSForms.Label
    Dim objFore As MSForms.Label
    Dim oProgress As MSForms.Label
    Dim objAbort As MSForms.CommandButton
  
    Set objBack = Me.Controls("Back")
    Set objFore = Me.Controls("Fore")
    Set oProgress = Me.Controls("Progress")
    Set objAbort = Me.Controls("Abort")
    objBack.Visible = bShow
    objFore.Visible = bShow
    oProgress.Visible = bShow
    objAbort.Visible = bShow
    If bShow Then
        objFore.Width = (objBack.Width - 2&) * Progress
        oProgress.Caption = "Downloading " & Round(Progress * 100&, 2&) & " %"
    End If
End Sub

Private Function GetDriverVersions() As Variant()
    GetDriverVersions = Array( _
        "114.0.5735.90", _
        "114.0.5735.16", _
        "113.0.5672.63", _
        "113.0.5672.24", _
        "112.0.5615.49", _
        "112.0.5615.28", _
        "111.0.5563.64", _
        "111.0.5563.41", _
        "111.0.5563.19", _
        "110.0.5481.77", _
        "110.0.5481.30", _
        "109.0.5414.74", _
        "109.0.5414.25", _
        "108.0.5359.71", _
        "108.0.5359.22", _
        "107.0.5304.62", _
        "107.0.5304.18", _
        "106.0.5249.61", _
        "106.0.5249.21", _
        "105.0.5195.52", _
        "105.0.5195.19", _
        "104.0.5112.79", _
        "104.0.5112.29" _
    )
End Function

 

[ballgnm]

    If Len(Dir(sSaveToFilePath, vbDirectory)) Then
        Open sSaveToFilePath + "\chromedriver" + sVersion + ".zip" For Binary As #iFreeFile
    Else
        http.Abort
        Close #iFreeFile
        ShowProgressBar , False
        Me.Height = Me.Height - 50&
        MsgBox "Save Path not valid.", vbExclamation
    End If

is there any particular reason to use Len(Dir(sSaveToFilePath, vbDirectory)) instead of just Dir(sSaveToFilePath, vbDirectory)?

 

[Jaafar Tribak]

If you use Dir(sSaveToFilePath, vbDirectory) w/o the Len function then you will need to check that it doesn't return an empty string

If Dir(sSaveToFilePath, vbDirectory) <> "" Then

So, basically, both ways are valid for checking that a folder exists.

 

[ballgnm]

If you use Dir(sSaveToFilePath, vbDirectory) w/o the Len function then you will need to check that it doesn't return an empty string
So, basically, both ways are valid for checking that a folder exists.

Yeah, I know, I thought you had a different reason. So it was your personal preference.

 

[Dan_W]

Yeah, I know, I thought you had a different reason. So it was your personal preference.

I can't speak for Jaafar, but the popular view is that it is slower to check/compare strings, versus checking the length of those strings, which is what Jaafar's approach above does. You can see a discussion about it here: File Sys Object ???-VBForums

It may all be much of a muchness for your code scenario above where the code is testing the existence of a single path, but on one view, the better (or at least, the faster) approach is to use the Len(Dir(Filename)).