Question

家长帖子： VBA: Selecting from dropdown menu to reload page and scraping data

显然我不知道如何使用stackoverflow：我删除了我的个人资料，认为我正在“静音”电子邮件更新。刚刚开始编写VBA编码，不太清楚我在做什么。在强大的用户SIM的帮助下，代码正在运行。

我试图进一步修改代码，改变web url地址，以便插入我放在单元格J1中的任何股票代码。在这种情况下，我试图查找的不仅仅是jpm。

这里的目标是在J1中添加任何股票代码，它将反映在查询网址上。例如： J1将保持AAPL，而.Open命令将是

.Open "POST", "https://www.nasdaq.com/symbol/jpm/historical", False

或者J1将保留WFC，而.Open命令将是

.Open "POST", "https://www.nasdaq.com/symbol/WFC/historical", False

然而，我的尝试并没有那么热。这是我到目前为止所拥有的。

Sub Get_Data()
    Dim tabd As Object, trow As Object, r&, c&
    Dim QueryString$, S$

    QueryString = "10y|false|" & Range("J1").Value & "" ''change here the "year" and the "ticker" name as necessary
    ''Set web_url = "https://www.nasdaq.com/symbol/" & Range("J1").Value & "/historical"

    Range("A:F").ClearContents

    With New XMLHTTP
        .Open "POST", "https://www.nasdaq.com/symbol/jpm/historical", False
        ''.Open "POST", "web_url", False
        .setRequestHeader "User-Agent", "IE"
        .setRequestHeader "Content-Type", "application/json"
        .send QueryString
        S = .responseText
    End With
    With New HTMLDocument
        .body.innerHTML = S
        For Each tabd In .getElementById("quotes_content_left_pnlAJAX").getElementsByTagName("table")(0).Rows
            For Each trow In tabd.Cells
                c = c + 1: Cells(r + 1, c) = trow.innerText
            Next trow
            c = 0: r = r + 1
        Next tabd
    End With

End Sub

我评论了那部分不起作用的部分。

Answer 1

实际上，您的评论部分几乎是正确的。由于您要创建字符串，因此无法使用Set，并且网址中的代码必须为小写。另外，您在"web_url"方法中将Open作为字符串文字传递。

这就是你要做的：

Sub Get_Data()
    Dim tabd As Object, trow As Object, r&, c&
    Dim QueryString$, S$

    QueryString = "10y|false|" & Range("J1").Value & "" ''change here the "year" and the "ticker" name as necessary
    web_url = "https://www.nasdaq.com/symbol/" & LCase(Range("J1").Value) & "/historical"

    Range("A:F").ClearContents

    With New XMLHTTP
        .Open "POST", web_url, False
        .setRequestHeader "User-Agent", "IE"
        .setRequestHeader "Content-Type", "application/json"
        .send QueryString
        S = .responseText
    End With
    With New HTMLDocument
        .body.innerHTML = S
        For Each tabd In .getElementById("quotes_content_left_pnlAJAX").getElementsByTagName("table")(0).Rows
            For Each trow In tabd.Cells
                c = c + 1: Cells(r + 1, c) = trow.innerText
            Next trow
            c = 0: r = r + 1
        Next tabd
    End With

End Sub

Excel VBA：根据单元格值更改URL

1 个答案: