Use VBA to Download a File

[davidawitkin]

Hello. I'm developing an Excel VBA application. One of the functions of the application is to check the internet when the user clicks a button to determine if there is a newer version of the application that is available for download. If a new version of the application is available, VBA gets it from the internet and saves the installer (an executable) to the desktop. All of this is working fine.

Where I'm running into a problem is trying to asynchronously download the executable file AND show a status of how much of the file has been downloaded. The file is 4.5 MB and some (hopefully not many, though) of my users will have dial-up connections. As a result, I think I need to have some type of updated status during the download in case it takes an hour or more for someone dialing up.

The issue is that, while I appear to be downloading the file asynchronously, I can't figure out how to intermittently determine how many bytes have been downloaded. I am not licensed for the inet object that allows 'chunking' so I'm using the XMLHTTP object to handle the download.

On a seperate but possibly related issue, the ReadyState seems to go directly to 4 (complete) without passing through the other ready states.

Below is my code that successfully downloads the file. Right now, I have some message boxes in there to help me troubleshoot.

Any help would be greatly appreciated!

Public Sub DownloadInternetFile()
'****************************************************************************************************
'   This function is will download a new version of the program.  The function uses
'   the XMLHTTP object to download files directly from HTTP site.   The URL to download
'   and the file name to save as are parameters passed by the calling procedure.
'****************************************************************************************************
'   Version: 1.0
'   Last Modified: 2005-06-16
'   Written by:  ...
'****************************************************************************************************

    Dim StatusMsg As String, FileSize As String, LastModified As String
    Dim HeaderData As String, StartTime As Date, EndTime As Date, StateTime As Date
    Dim BinaryData As Variant, BinaryData1 As Variant, BinaryData2 As Variant
    Dim BinaryData3 As Variant, BinaryData4 As Variant
    Dim UnformattedData As String, CurrentState As Variant
    Dim FileURL As Variant, SaveFileAs As String, i As Integer, tmp As Double
    
    Const adTypeBinary = 1
    Const adSaveCreateNotExist = 1
    Const adSaveCreateOverWrite = 2
        
    Set WSH = CreateObject("WScript.Shell")
    Set HttpObj = CreateObject("Microsoft.XMLHTTP")
    Set BinaryStream = CreateObject("ADODB.Stream")
    CurrentState = -1
    
    FileURL = "http://home.comcast.net/~davidawitkin/AdbeRdr60_enu_full.exe"
    SaveFileAs = WSH.SpecialFolders("Desktop") & "\" & "AdbeRdr60_enu_full.exe"
    
    StartTime = Now()
    HttpObj.Open "GET", FileURL, True
    HttpObj.Send

    
    CurrentState = HttpObj.ReadyState
    Do Until CurrentState = 4
        CurrentState = HttpObj.ReadyState
        Select Case CurrentState
            Case 1
                StateTime = Now()
                StatusMsg = StatusMsg & vbNewLine & "State 1: " & StateTime & _
                            "Size: " & Len(HttpObj.ResponseText)
                CurrentState = HttpObj.ReadyState
            Case 2
                StateTime = Now()
                StatusMsg = StatusMsg & vbNewLine & "State 2: " & StateTime & _
                            "Size: " & Len(HttpObj.ResponseText)
                CurrentState = HttpObj.ReadyState
            Case 3
                StateTime = Now()
                StatusMsg = StatusMsg & vbNewLine & "State 3: " & StateTime & _
                            "Size: " & Len(HttpObj.ResponseText)
                CurrentState = HttpObj.ReadyState
        End Select
        CurrentState = HttpObj.ReadyState
    Loop

    StateTime = Now()
    StatusMsg = StatusMsg & vbNewLine & "State 4: " & StateTime & vbNewLine & _
              "Size: " & Len(BinaryData)
    MsgBox StatusMsg, 64, "State Change Info"
    
    ' Load the binary data into a variable.
    BinaryData = HttpObj.ResponseBody
    
    ' Specify stream type - we want To save binary data.
    BinaryStream.Type = adTypeBinary
    
    ' Open the stream And write binary data To the object
    BinaryStream.Open
    BinaryStream.Write BinaryData
    
    ' Save binary data To disk
    BinaryStream.SaveToFile SaveFileAs, adSaveCreateOverWrite
    EndTime = Now()

    ' Get header data As a string
    UnformattedData = HttpObj.GetResponseHeader("Content-Length")
    FileSize = FormatNumber(UnformattedData / 1024000, 1, , -1)
    LastModified = HttpObj.GetResponseHeader("Last-Modified")
    StatusMsg = "File Size: " & FileSize & " Mbytes" & vbNewLine & _
                "Last Modified: " & LastModified & vbNewLine & _
                "Binary Data Size: " & BinaryStream.Size
    MsgBox StatusMsg, 64, "HeaderData"
    
End Sub

 

[krish]

hello,

I don't know the answer to your question. sorry. I am also trying to do similar but I have a problem with adodb.stream. from where can I download adodb.stream?. I checked MS site and couldn't find the download. I did downloaded mdac2.8 and the code is not working. could you please help? thanks