VBA: Selecting from dropdown menu to reload page a

问题:

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>

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"

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!

Edit: included cell A1 value: JPM. Thanks!

回答1:

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

Reference to add to the library:

Microsoft XML, V6.0
Microsoft HTML Object Library