VBA:从下拉菜单中选择重新加载页面和抓取数据

时间:2018-04-29 22:00:52

标签: vba excel-vba web-scraping excel

我试图从纳斯达克的10年历史报价数据中获取各种股票的数据。这是网站的代码:

<h4>Get up to 10 years of daily historical stock prices &amp; volumes.</h4>

<div class="floatL">
    <p>Select the Timeframe:</p>
</div>
<div class="floatL marginT10px fontS14px">
    <select id="ddlTimeFrame" name="ddlTimeFrame" onchange="getQuotes(false)">
        <option value="5d">5 Days</option>
        <option value="1m">1 Month</option>
        <option value="3m" selected="selected">3 Months</option>
        <option value="6m">6 Months</option>
        <option value="1y">1 Year</option>
        <option value="18m">18 Months</option>
        <option value="2y">2 Years</option>
        <option value="3y">3 Years</option>
        <option value="4y">4 Years</option>
        <option value="5y">5 Years</option>
        <option value="6y">6 Years</option>
        <option value="7y">7 Years</option>
        <option value="8y">8 Years</option>
        <option value="9y">9 Years</option>
        <option value="10y">10 Years</option>
    </select>
</div>

我会在单元格A1中输入股票代码。 Cell A1持有&#39; JPM&#39;。 这是我的vba获取代码。我试图打开网页,选择10yr选项,创建一个对象并将表格提取到Excel。

'setting up
Sub HTML_Table_To_Excel()
Dim htm As Object
Dim Tr As Object
Dim Td As Object
Dim Tab1 As Object
Dim IE As Object

'download webpage URL
Web_URL = "https://www.nasdaq.com/symbol/" & Range("A1").Value & "/historical" _

'select time from dropdown menu
Sub IE_Navigate()

'Use IE
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

IE.navigate ("Web_URL")

'Wait for Load to finish
While IE.readyState <> 4
DoEvents
Wend
Application.Wait (Now + TimeValue("0:00:01"))

'selects item
IE.document.getElementsByName("ddlTimeFrame")(0).Value = '10y' _

'Create HTMLFile Object
Set HTML_Content = CreateObject("htmlfile")

'Get the WebPage Content to HTMLFile Object
With CreateObject("msxml2.xmlhttp")
    .Open "GET", Web_URL, False
    .send
    HTML_Content.Body.Innerhtml = .responseText
End With

Column_Num_To_Start = 1
iRow = 2
iCol = Column_Num_To_Start
iTable = 0

'Loop Through Each Table and Download it to Excel in Proper Format
For Each Tab1 In HTML_Content.getElementsByTagName("table")
    With HTML_Content.getElementsByTagName("table")(iTable)
        For Each Tr In .Rows
            For Each Td In Tr.Cells
                Sheets(1).Cells(iRow, iCol).Select
                Sheets(1).Cells(iRow, iCol) = Td.innerText
                iCol = iCol + 1
            Next Td
            iCol = Column_Num_To_Start
            iRow = iRow + 1
        Next Tr
    End With
    iTable = iTable + 1
    iCol = Column_Num_To_Start
    iRow = iRow + 1
Next Tab1

MsgBox "Process Completed"

我已经尝试了各种其他选项,混合和匹配,我认为这是我最接近它的工作,除了选择部分。给了我一个&#39;结束子&#39;第'IE.document.getElementsByName("ddlTimeFrame")(0).Value = '10y' _行的错误和有关自动化错误的错误 谢谢!

编辑:包含单元格A1值:JPM。谢谢!

1 个答案:

答案 0 :(得分:1)

给出一个镜头并获得您希望刮去的所需数据。我使用xmlhttp请求来加快操作速度。

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

    QueryString = "10y|false|JPM" ''change here the "year" and the "ticker" name as necessary

    With New XMLHTTP
        .Open "POST", "https://www.nasdaq.com/symbol/jpm/historical", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .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

参考添加到库:

Microsoft XML, V6.0
Microsoft HTML Object Library