從第三方網站下載並保存文件

Question

我需要在Excel中使用VBA從第三方Web應用程序下載文件。 到目前為止，這是我的代碼：

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

麻煩的是，此代碼將文件成功保存到目標位置。 但是在嘗試打開文件時，它表示文件已損壞或擴展名不正確。 但是，文件大小等於我通過手動下載獲得的文件。

任何幫助都非常感謝。

Answer 1

嘗試這個：

'' 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