VBA:从下拉菜单中选择以重新加载页面并抓取数据 [英] VBA: Selecting from dropdown menu to reload page and scraping data

问题描述

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

I'm trying to scrape data from 10yr historical quote data from Nasdaq for various stocks. Here's the website's code:

<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中输入股票行情代码.单元格A1保留"JPM". 这是我的vba提取代码.我正在尝试打开网页，选择10yr选项，创建一个对象并将表格提取到Excel.

And I would be input the stock ticker symbol in cell A1. Cell A1 holds 'JPM'. Here's my vba fetch code. I'm trying to open up the webpage, select the 10yr option, create an object and fetch the table to 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"

我尝试了其他各种选项，包括混合和匹配，我认为这是除选择部分之外，我最接近使用的选项.在行'IE.document.getElementsByName("ddlTimeFrame")(0).Value = '10y' _上给了我一个'end sub'错误和一个关于自动化错误的错误 谢谢！

I've tried various other options, mix and matching, and I think this is the closest I've got it to work, except the selection part. Gave me a 'end sub' error and an error about automation error at line 'IE.document.getElementsByName("ddlTimeFrame")(0).Value = '10y' _ Thanks!

包含的单元格A1值:JPM.谢谢！

included cell A1 value: JPM. Thanks!

推荐答案

试一下，获取您希望抓取的所需数据.我使用xmlhttp请求来加快操作速度.

Give this a shot and get the required data you wished to scrape. I used xmlhttp request to make the operation way faster.

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

这篇关于VBA:从下拉菜单中选择以重新加载页面并抓取数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！