VBA-如何从网站下载.xls并将数据放入Excel文件 [英] VBA - How to download .xls from website and put data into excel file

问题描述

我设法使用VBA达到可以从网络上下载excel文件的程度，但是我在弄清楚如何实际下载该文件并将其内容放入excel文件时遇到了麻烦.我在工作.有什么建议吗?谢谢

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 = "[e-mail]"
    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

这篇关于VBA-如何从网站下载.xls并将数据放入Excel文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！