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

从第三方网站下载并保存文件

1 个答案: