Download and save file from third party website

Question

I need to download a file from a third party web application using VBA in Excel. This is my code so far:

Dim myURL As String
myURL = "https://somewebsite/?f=13385&ver=a1df4089f0e4d11cf6b48024309fc9"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")

WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send

myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile "C:\Users\xxx\abc.xlsx", 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
End If

The trouble is that, this code saves a file successfully to the destination. But on attempting to open the file it says the file is corrupted or that the extension is incorrect. The file size however is equal to the file I obtain through a manual download.

Any help is very appreciated.

Try this link: http://stackoverflow.com/questions/17877389/how-do-i-download-a-file-using-vba-without-internet-explorer — PKatona, Jan 07 '16 at 23:55
With apologies, I rarely attempt to provide a solution that I cannot test first. — , Jan 08 '16 at 05:08

score 0 · Answer 1 · answered Jul 25 '16 at 14:01

try this:

'' This function downloads a file from a given webpage named 'url' and copies it to 'copylocation' named as 'filename'.
'' It is vital to check which format does the content has. For example: xlsx, csv, txt etc. This must be determined in 'downloadformat'.
'' If an already existing file should be overwriten, then overwritefile = TRUE must be set.
''
'' Example of use: GetWebpageContent("http://www.snb.ch/n/mmr/tcoreference/Current%20Rates/Interest_Rates/source/interest_rates.xlsx",
''              "F:\public\CurrentMarketRates",
''              "SARM", "xlsx", TRUE)
''
Function GetWebpageContent(url As String, copylocation As String, filename As String, downloadformat As String, overwritefile As Boolean) As Boolean
    Dim WinHttpReq As Object, fname As String, res As Boolean
    Dim owritef As Integer
        owritef = 1
    ''do not overwrite, unless overwritefile = TRUE
    If overwritefile Then
        owritef = 2
    End If
    ''create filename and location
    res = True
    fname = "\" & filename & "_" & Year(Now) & "." & downloadformat

    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", url, False
    WinHttpReq.Send

    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile copylocation & fname, 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If

    GetWebpageContent = res
End Function

Download and save file from third party website

1 Answers1