VBA - How to download .xls from website and put data into excel file

问题

I managed to use VBA to get to the point where I'm ready to download an excel file from the web but I'm having trouble figuring out how to actually download that file and put its contents into an excel file I'm working in. Any suggestions? Thanks

Here is the code so far:

Sub GetData()

Dim IE As InternetExplorer
Dim HTMLDoc As HTMLDocument
Dim objElement As HTMLObjectElement

Set IE = New InternetExplorer
With IE
    .Visible = True
    .Navigate "http://www.housepriceindex.ca/default.aspx"
    While .Busy Or .ReadyState <> READYSTATE_COMPLETE: Wend
    .Document.getElementById("lnkTelecharger2").Click
    While .Busy Or .ReadyState <> READYSTATE_COMPLETE: Wend
    Set HTMLDoc = .Document
    Set objElement = HTMLDoc.getElementById("txtEmailDisclaimerEN")
    objElement.Value = "abc@abc.com"
    Set objElement = HTMLDoc.getElementById("lnkAcceptDisclaimerEN")
    objElement.Click

    ' ... Get CSV somehow ...

    '.Quit

End With

Set IE = Nothing
End Sub

回答1:

Try the below code:

Option Explicit

Sub ImportHistoricalDataSheet()

    Const SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS = 13056
    Const adSaveCreateOverWrite = 2

    Dim aBody, sPath

    ' Download Historical Data xls file via XHR
    With CreateObject("MSXML2.XMLHTTP")
    'With CreateObject("MSXML2.ServerXMLHTTP")
        '.SetOption 2, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
        .Open "GET", "http://www.housepriceindex.ca/Excel2.aspx?langue=EN&mail=abc%40abc.com"
        .Send
        ' Get binary response content
        aBody = .responseBody
        ' Retrieve filename from headers and concatenate full path
        sPath = ThisWorkbook.Path & "\" & Replace(Split(Split(.GetAllResponseHeaders, "filename=", 2)(1), vbCrLf, 2)(0), "/", "-")
    End With
    ' Save binary content to the xls file
    With CreateObject("ADODB.Stream")
        .Type = 1
        .Open
        .Write aBody
        .SaveToFile sPath, adSaveCreateOverWrite
        .Close
    End With
    ' Open saved workbook
    With Workbooks.Open(sPath, , True)
        ' Get 1st worksheet values to array
        aBody = .Worksheets(1).UsedRange.Value
        .Saved = True
        .Close
    End With
    ' Delete saved workbook file
    CreateObject("Scripting.FileSystemObject").DeleteFile sPath, True
    ' Insert array to target worksheet
    ThisWorkbook.Sheets("Sheet1").Cells(1, 1).Resize(UBound(aBody, 1), UBound(aBody, 2)).Value = aBody

End Sub

来源：https://stackoverflow.com/questions/41726225/vba-how-to-download-xls-from-website-and-put-data-into-excel-file