В этом посте я покажу, как с помощью VBA сделать, то, для чего VBA вроде бы как изначально не предназначен – как получить значения нужных переменных из структуры JSON.
Этот пост сделан как продолжение поста «Макрос получения курсов доллара за период с сайта Банка России».
В чем отличие между сервисом ЦБ России и сайтом worldometers.info? В том, что ЦБ предлагает XML сервис для автоматической загрузки информации (см. http://www.cbr.ru/development/SXML/) – ее неудобно смотреть через веб браузер, но удобно получать с помощью паучьих алгоритмов, а worldometers.info предлагает информацию для людей, а не для пауков.
Поэтому создаваемому на 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 файл с кодом можно скачать здесь. Если будут вопросы – пишите их сюда.