VBA: выбор из выпадающего меню для перезагрузки страницы и очистки данных

Question

Я пытаюсь собрать данные из 10-летних исторических котировок Nasdaq для различных акций. Вот код сайта:

<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. Я пытаюсь открыть веб-страницу, выбрать опцию 10 лет, создать объект и загрузить таблицу в 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"

Я пробовал другие варианты, смешивание и сопоставление, и я думаю, что это самое близкое, что у меня есть, кроме части выбора. Дали мне ошибку 'end sub' и ошибку об ошибке автоматизации в строке 'IE.document.getElementsByName("ddlTimeFrame")(0).Value = '10y' _ Спасибо!

Редактировать: включено значение ячейки A1: JPM. Спасибо!

Answer 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