VBA – 如何从网站下载.xls并将数据放入excel文件

我设法使用VBA,以准备好从网上下载一个Excel文件,但我很难找出如何实际下载该文件,并将其内容放入我正在工作的Excel文件。 有什么build议么? 谢谢

这是迄今为止的代码:

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 

试试下面的代码:

 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