Safe Download

[Robbo]

A while ago I asked a question and was given a solution that I thought worked
well (can't find original question because Notify me of replies doesn't work
and I don't know where to look)

Anyway I needed a way to download a file from the internet that allowed the
user an out if it took too long. The following function acheives the desired
result for most files I use but if I try to download a zip file, the file is
corrupt. Can anyone help me fix it so that it will safely and reliably
download zip files?

Function WebDownload(URL As String, SaveToFileName As String) As Boolean
Dim xh As MSXML2.XMLHTTP
Dim sURL As String
Dim vFF As Long
Dim oResp() As Byte
Dim lRndKey As Long

On Error GoTo WebDownload_Error

Me.TimerInterval = 200 'timer refresh rate
gdTimer = Timer()

'empty the cache so the last version is downloaded
lRndKey = Int(Rnd * 100000)
sURL = URL & "?rndkey=" & lRndKey
DeleteUrlCacheEntry sURL

'download the file
Set xh = New MSXML2.XMLHTTP
xh.Open "GET", sURL, True
xh.Send
mAbort = False

'Wait for the download to finish allowing the process to stop if required
Do While Not (xh.readyState = 4 Or mAbort)
DoEvents
Me.LapsedTime = Timer() - gdTimer
Loop

If mAbort Then
giDlOutcome = 2 'Download attempt was aborted by user
Me.LapsedTime = Timer() - gdTimer

LogError 999, "User aborted download of " & URL _
& " to " & SaveToFileName _
& " after (secs): " & Me.LapsedTime _
, "frmDownload", "WebDownload", "000", , errNoMsg

ElseIf IsEmpty(xh.responseBody) Then
giDlOutcome = 3 'Download resulted in an empty file
Me.LapsedTime = Timer() - gdTimer

LogError 999, "Download of " & URL _
& " to " & SaveToFileName _
& " resulted in an empty file after (secs): " & Me.LapsedTime _
, "frmDownload", "WebDownload", "000", , errNoMsg

Else
'Create local file and save results to it
oResp = xh.responseBody 'Returns the results as a byte array
vFF = FreeFile
If Dir(SaveToFileName) <> "" Then Kill SaveToFileName
Open SaveToFileName For Binary As #vFF
Put #vFF, , oResp
Close #vFF

giDlOutcome = 1 'download was successful

Me.LapsedTime = Timer() - gdTimer

LogError 888, "Successfully downloaded " & URL _
& " to " & SaveToFileName _
& " after (secs): " & Me.LapsedTime _
, "frmDownload", "WebDownload", "000", , errNoMsg

End If

'Clear memory
Set xh = Nothing

Me.TimerInterval = 2

On Error GoTo 0
Exit Function

WebDownload_Error:
Stop
LogError Err.Number, Err.Description, "Form_frmDownload", "WebDownload", Erl
Exit Function
Resume

End Function

 

[Robbo]

Well I have just tried something different and got it to work BUT the
solution has left me just as baffled. I copied the web address I was trying
to download into Internet Explorer and it told me it was an invalid address.
I checked it letter by letter, space by space, but it's not. So I removed the
file name from the address to see if it was having trouble finding the web
site or the file. That worked fine. So then I copied and pasted the name of
the file from my computer (the one I had uploaded), pasted it onto the end of
the web address and it found it. I copied that web address into my VBA code
and it works. Yet there is no difference in spelling between the original and
the one that works. I remain lost.