Как найти и распарсить JSON на странице сайта в интернете с помощью VBA Excel?

В этом посте я покажу, как с помощью VBA сделать, то, для чего VBA вроде бы как изначально не предназначен – как получить значения нужных переменных из структуры JSON.

Этот пост сделан как продолжение поста «Макрос получения курсов доллара за период с сайта Банка России».

В чем отличие между сервисом ЦБ России и сайтом worldometers.info? В том, что ЦБ предлагает XML сервис для автоматической загрузки информации (см. http://www.cbr.ru/development/SXML/) – ее неудобно смотреть через веб браузер, но удобно получать с помощью паучьих алгоритмов, а worldometers.info предлагает информацию для людей, а не для пауков.

Поэтому создаваемому на VBA паучку придется постараться, чтобы понять разметку «для людей».

Для работы паука необходимо дополнительно подключить три библиотеки:

1. Microsoft XML parser (MSXML) – тот же, что использовался для получения курсов ЦБ с сайта Банка России.
2. Библиотеку для работы с объектной моделью HTML.
3. Библиотеку для использования возможностей JavaScript из VBA.

Запускаем паучка на сайт: https://www.worldometers.info/coronavirus/coronavirus-cases/

Sub GetJSONformHTML()
    Dim xmlhttp As New MSXML2.XMLHTTP60, urlWorldometers As String
    urlWorldometers = "https://www.worldometers.info/coronavirus/coronavirus-cases/"
    xmlhttp.Open "GET", urlWorldometers, False
    xmlhttp.setRequestHeader "Content-Type", "text/json"
    xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    xmlhttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.3; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/81.0.4044.138 Safari/537.36"
    xmlhttp.send
                                

В полученном html паучку нужно найти и распарсить данные о количестве зарегистрированных случаев из формата JSON. Эти данные представлены вторым аргументом в вызове функции Highcharts.chart(chartName, chartData), которая на сайте рисует график.

    Dim html As New HTMLDocument
    html.body.innerHTML = xmlhttp.responseText
                                

В результате выполнения нижепредставленного кода в переменной strJson должна оказаться структура с данными в JSON формате.

    Dim scripts As IHTMLDOMChildrenCollection
    Set scripts = html.querySelectorAll("script")
    Dim i As Integer, start As Integer, finish As Integer, strJson As String, jsfunc As String
    Dim strGraph As String
    strGraph = "Highcharts.chart('coronavirus-cases-linear',"
    For i = 0 To scripts.Length - 1
      start = InStr(scripts(i).innerHTML, strGraph)
      If start > 0 Then
       finish = InStr(scripts(i).innerHTML, ");")
       jsfunc = scripts(i).innerHTML
       start = start + Len(strGraph)
       strJson = Mid(jsfunc, start, finish - start)
       Exit For
      End If
    Next
                                

Теперь самое интересное – как распарсить эту JSON структуру? Чистый VBA это делать не умеет. Но с JSON прекрасно работает JavaScript.

А в VBA есть инструмент для использования возможностей JavaScript для пользователей MS Excel.

    Dim myJSCript As ScriptControl
    Set myJSCript = New ScriptControl
    myJSCript.Language = "JScript"
                                

Мы можем в VBA получить уже распарсенную JSON переменную:

    Dim objJSON As Object
    Set objJSON = myJSCript.Eval("(" + strJson + ")")
                                

Проблема в том, что с объектом objJSON ничего нельзя сделать в рамках VBA – у него нет ни свойств, ни методов. Поэтому создаем эти методы на языке JavaScript. Нам нужно вытащить даты (xAxis) и количество (series->data):

Вот что пишем в VBA редакторе:

    myJSCript.AddCode "function getDataSeries(jstruct) {return jstruct['series'][0]['data'];}"
    myJSCript.AddCode "function getxAxis(jstruct) {return jstruct.xAxis.categories;}"
                                

Загоняем данные в привычные VBA массивы:

    Dim v1 As String, v2 As String
    v1 = myJSCript.Run("getDataSeries", objJSON)
    v2 = myJSCript.Run("getxAxis", objJSON)
    Dim x() As String, d() As String
    x() = Split(v2, ",")
    d() = Split(v1, ",")
                                

Ну и раскатываем эти массивы по рабочему листу:

    For i = 0 To UBound(x)
     Range("A" & i + 1) = x(i)
     Range("B" & i + 1) = d(i)
    Next
    Set objJSON = Nothing
    Set scripts = Nothing
    html.Close
    Set xmlhttp = Nothing
    Set myJSCript = Nothing
    MsgBox "Готово."
End Sub
                                

Вот, что получилось в результате на листе рабочей книги:

По этим данным легко построить график, например, такой:

Excel файл с кодом можно скачать здесь. Если будут вопросы – пишите их сюда.