Downloading png to disk creates broken file - ms-access

Question

In my project, I want to download a png file from a url and save it to disk.
I have a url to an image, and I can load it in my web browser without any problem.
But when I use Access to download this file and save it, it saves "a" file, but it doesn't seem to have any image. Every file it creates is 167kb, and I cannot view them with my graphics viewers (XnViewMP, for example).
When I load the created file with PE Studio, it says the MZ signature is missing (I'm not sure that means anything).
I've tried this with an .ico file on my local webserver, too, and have the same issue.
Here is the code I'm using to download the image file.
Public Function DownloadFile(whaturl As String, whatdestination As String) As Boolean
Dim newfilepath
Dim success As Boolean
Dim WinHttpReq: Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", whaturl, False
WinHttpReq.Send
If WinHttpReq.Status = 200 Then
Dim oStream: Set oStream = CreateObject("ADODB.Stream")
oStream.type = 1 '1 is binary
oStream.Open
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile whatdestination, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
success = True
Else
success = False
End If
DownloadFile = success
End Function
Maybe someone can tell my why this code seems to fail in downloading the png file? I've tried with an .ico file, too, and have the same problem. Maybe someone can help me with this code?

Answer 1

You are making it too hard. Use a function like this:
Option Compare Database
Option Explicit
' API declarations.
'
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
' Download a file or a page with public access from the web.
' Returns 0 if success, error code if not.
'
' If parameter NoOverwrite is True, no download will be attempted
' if an existing local file exists, thus this will not be overwritten.
'
' Examples:
'
' Download a file:
' Url = "https://www.codeproject.com/script/Membership/ProfileImages/%7Ba82bcf77-ba9f-4ec3-bbb3-1d9ce15cae23%7D.jpg"
' FileName = "C:\Test\CodeProjectProfile.jpg"
' Result = DownloadFile(Url, FileName)
'
' Download a page:
' Url = "https://www.codeproject.com/Tips/1022704/Rounding-Values-Up-Down-By-Or-To-Significant-Figur?display=Print"
' FileName = "C:\Test\CodeProject1022704.html"
' Result = DownloadFile(Url, FileName)
'
' Error codes:
' -2146697210 "file not found".
' -2146697211 "domain not found".
' -1 "local file could not be created."
'
' 2004-12-17. Gustav Brock, Cactus Data ApS, CPH.
' 2017-05-25. Gustav Brock, Cactus Data ApS, CPH. Added check for local file.
' 2017-06-05. Gustav Brock, Cactus Data ApS, CPH. Added option to no overwrite the local file.
'
Public Function DownloadFile( _
ByVal Url As String, _
ByVal LocalFileName As String, _
Optional ByVal NoOverwrite As Boolean) _
As Long
Const BindFDefault As Long = 0
Const ErrorNone As Long = 0
Const ErrorNotFound As Long = -1
Dim Result As Long
If NoOverwrite = True Then
' Page or file should not be overwritten.
' Check that the local file exists.
If Dir(LocalFileName, vbNormal) <> "" Then
' File exists. Don't proceed.
Exit Function
End If
End If
' Download file or page.
' Return success or error code.
Result = URLDownloadToFile(0, Url & vbNullChar, LocalFileName & vbNullChar, BindFDefault, 0)
If Result = ErrorNone Then
' Page or file was retrieved.
' Check that the local file exists.
If Dir(LocalFileName, vbNormal) = "" Then
Result = ErrorNotFound
End If
End If
DownloadFile = Result
End Function
taken from my article: Show pictures directly from URLs in Access forms and reports
(If you don't have an account, browse for the link: Read the full article)
Full code is also at GitHub: VBA.PictureUrl