单击网站上的按钮并将数据文件下载到 Excel

Question

我正在尝试从网站下载数据并将其放入我的 excel 文件中。

以下是我正在尝试做的步骤：

1) 访问网站：http://www.housepriceindex.ca/default.aspx

2）点击“下载历史数据（.xls）”（我卡在这里）

3)在底部输入邮箱地址(abc@abc.com)

4)点击接受

5)将刚刚下载的.xls文件中的数据转移到我的文件中。

这是目前的代码：

Sub GetData()


Dim i As Long
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object

Set IE = CreateObject("InternetExplorer.Application")

IE.Visible = True
IE.Navigate "http://www.housepriceindex.ca/default.aspx" 

Do While IE.Busy: DoEvents: Loop
Do Until IE.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop

IE.Document.GetElementByID(lnkTelecharger2).Click


End Sub

感谢任何帮助！

Answer 1

所以我会这样做：

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 = "Email Address"
    Set objElement = HTMLDoc.getElementById("lnkAcceptDisclaimerEN")        
    objElement.Click

    ' ... Get CSV somehow ...

    .Quit
End With

Set IE = Nothing
End Sub

现在显然这仍然给您留下了捕获 CSV 的问题-我尝试了多种不同的方法来将工作簿变量设置为 CSV，但没有成功...问题是您单击的按钮没有包含您要下载的 CSV 的 URL，因此除非其他人知道如何捕获被提示打开或保存的文件，否则我可以帮助您..

问候， 丝绸之路

Answer 2

您可以通过其类名 (button small download) 定位按钮：

IE.document.querySelector(".button.small.download").Click

或

IE.document.getElementsByClassName("button small download")(0).Click

---

但是：

如果您熟悉 JSON，则可以完全避免登录。您要点击的按钮上方有一个 JSON 链接：

data-data_url：

您可以将其与XMLHTTPRequest 一起使用来获取JSON 数据，然后使用JSONConverter. 等工具解析响应。将 .bas 添加到项目后，您需要转到 VBE>Tools>References 并添加对 Microsoft Scripting Runtime 的引用。

这里只是一个大纲，展示了设置初始 JSON 对象和提取一些信息的过程。

Option Explicit
Public Sub GetInfo()
    Dim strURL As String, strJSON As String, Http As Object, json As Object
    Application.ScreenUpdating = False
    strURL = "https://housepriceindex.ca/_data/indx_data.json?d=4dfb05da"

    Set Http = CreateObject("MSXML2.XMLHTTP")
    With Http
        .Open "GET", strURL, False
        .send
        strJSON = .responseText
    End With
    Set json = JsonConverter.ParseJson(strJSON)

    Dim key As Variant, dictKeys As Variant
    '****************************************
    ' Set json = json("data") ' Array("indx", "spc", "indx_ch", "spc_ch", "Meta", "Data") '<== These are the keys in that dict.

    Set json = json("profiles")                  ' Array("c11", "mc","ab_calgary","ab_edmonton","bc_abbotsford","bc_kelowna" , _
                                                 "bc_vancouver","bc_victoria","mb_winnipeg","ns_halifax","on_barrie" , _
                                                 "on_brantford","on_guelph","on_hamilton","on_kingston","on_kitchener", _
                                                 "on_london","on_oshawa","on_ottawa","on_peterborough","on_st_catharines" , _
                                                 "on_sudbury","on_thunder_bay","on_toronto","on_windsor","qc_montreal","qc_quebec_city") '<==Keys in profile dict

    Dim dict As Object, rowNumber As Long
    Set dict = json("qc_montreal")

    With ThisWorkbook.Worksheets("Sheet1")
        For Each key In dict
             rowNumber = rowNumber + 1
            .Cells(rowNumber, 1) = key
            .Cells(rowNumber, 2) = dict(key)
        Next key
    End With
    Application.ScreenUpdating = True
End Sub

---

样品表输出：

---

示例源 JSON：

在顶级字典 ("JSON") 键 "data" 下的二级字典中有很多 C11 信息。