Очистка сайта для биржевых данных с пользовательскими тегами атрибутов

Question

Я пытаюсь создать макрос для очистки информации об акциях от investing.com на основе номера ISIN акции.

Пока у меня есть это:

Sub Get_Stock_Data()

  Dim Page As New XMLHTTP60
  Dim Doc As New HTMLDocument
  Dim inputbox As IHTMLElement

  Dim Table As IHTMLElement
  Dim Row As IHTMLElement
  Dim cel As IHTMLElement

  Page.Open "get", "https://www.investing.com/", False
  Page.send

  Doc.body.innerHTML = Page.responseText

  Set inputbox = Doc.getElementById("searchTextTop")
  inputbox.Value = "US0378331005"

  Set Table = Doc.getElementsByTagName("table")(1)

  For Each cel In Table.getElementsByTagName("td")
      Debug.Print cel.tagName, cel.className, cel.getAttribute("link")
  Next
End Sub

Номер ISIN вводится в главное окно поиска веб-страницы, которое состоит из следующих элементов:

<form onsubmit="" id="combineSearchFormTop" action="/" method="post">    
   <div class="inlineblock" id="searchBoxTop">       
     <input type="text" autocomplete="off" value="EUR/USD or AAPL" 
     default="EUR/USD or AAPL" class="searchText arial_12 lightgrayFont" 
     id="searchTextTop" name="quotes_search_text" prevvalue="">
   </div>
   <label for="searchTextTop" class="searchGlassIcon">&nbsp;</label>
   <i class="cssSpinner"></i>
</form>

Данная таблица является таблицей автозаполнения, созданной после ввода номера ISIN в поле поиска. Он содержит необходимую строку запроса, необходимую для перехода на главную страницу акции. Вот сегмент HTML, который содержит необходимую информацию.

<table>
  <tbody>
    <tr data-pair-id="6408" class="row hoverSearch" id="searchRowIdtop_0"> 
      <td class="first flag"><i class="ceFlags USA"></i></td> 
      <td class="second symbolName dirLtr" pairid="6408" id="symbol_AAPL" 
      link="/equities/apple-computer-inc">AAPL</td>                      
      <td class="third" title="Apple Inc">Apple Inc</td>
      <td class="fourth typeExchange" pairid="6408" id="type_6408" 
      link="/equities/apple-computer-inc">Equity - NASDAQ</td>
    </tr>
  </tbody> 
</table>

В основном я хочу получить строку из атрибута "ссылка" второго <td> тег. Однако, когда я запускаю код в Excel, непосредственное окно возвращает "ноль" для атрибутов "ссылки".

Заранее спасибо.

Answer 1

Посмотрите на приведенный ниже пример. Импортируйте модуль JSON.bas в проект VBA для обработки JSON.

Option Explicit

Sub Test()

    Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aData()
    Dim aHeader()

    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", "https://www.investing.com/search/service/search", False
        .SetRequestHeader "Accept", "application/json"
        .SetRequestHeader "X-Requested-With", "XMLHttpRequest"
        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64)"
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "search_text=US0378331005"
        sJSONString = .responseText
    End With
    JSON.Parse sJSONString, vJSON, sState
    vJSON = vJSON("All")
    JSON.ToArray vJSON, aData, aHeader
    With Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Выход с search_text параметр установлен как US0378331005 для меня так:

Кстати, аналогичный подход применяется в следующих ответах: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 и 13.