Я создал приложение, которое очищает данные с веб-сайта.
Код выполняется, как ожидается, для небольшого числа итераций.
Однако, когда код выполняется несколько раз, он вылетает с Automation Error
.
Моя цель - получать ежедневные результаты аукциона с этого веб-сайта для нескольких «границ» и нескольких «дат».
После проверки HTTP-запросов, отправляемых при просмотре сайта, я смог автоматизировать их и получить интересующие меня данные следующим образом:
Sub seecao()
Dim request As New WinHttpRequest
Dim htmlDoc As New MSHTML.HTMLDocument
Dim tableTest As HTMLTable
Dim rowHTML As HTMLTableRow
Dim cellHTML As HTMLTableCell
Dim requestURL As String
Dim responseJSON As Object
Dim reqBody As String
Dim reqResponse As String
Dim seecaoBordersArray As Variant
Dim areaOut As String
Dim areaIn As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim tempRng As Range
seecaoBordersArray = ThisWorkbook.Worksheets("Help").Range("seecaoBordersRng")
requestURL = "http://seecao.com/views/ajax"
Application.ScreenUpdating = False
For k = LBound(seecaoBordersArray, 1) To UBound(seecaoBordersArray, 1) Step 1
areaOut = seecaoBordersArray(k, 1)
areaIn = seecaoBordersArray(k, 2)
Set tempRng = ThisWorkbook.Worksheets("seecao").Cells.Find(What:=areaOut + areaIn, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
i = tempRng.Offset(2, 0).Row
j = tempRng.Offset(2, 0).Column
reqBody = ThisWorkbook.Worksheets("Help").Range("A1:A1") + Format(Date + 1, "yyyy-mm-dd") + ThisWorkbook.Worksheets("Help").Range("A2:A2") + areaOut + "+-+" + areaIn + ThisWorkbook.Worksheets("Help").Range("A3:A3")
With request
.Open "POST", requestURL, False
.setRequestHeader "Host", "seecao.com"
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.setRequestHeader "Referer", "http://seecao.com/daily-results"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send reqBody
reqResponse = .responseText
End With
Set responseJSON = JsonConverter.ParseJson(reqResponse)
htmlDoc.body.innerHTML = responseJSON(3)("data")
Set tableTest = htmlDoc.getElementsByTagName("table")(0)
For Each rowHTML In tableTest.Rows
If rowHTML.Cells(0).innerText <> "Date " Then
ThisWorkbook.Worksheets("seecao").Cells(i, j) = rowHTML.Cells(2).innerText
ThisWorkbook.Worksheets("seecao").Cells(i, j + 1) = rowHTML.Cells(5).innerText
i = i + 1
End If
Next rowHTML
Next k
Application.ScreenUpdating = True
End Sub
Тело HTTP-запроса состоит из различных параметров, которые образуют огромную строку. Я разделил эту строку на 3 части, чтобы иметь возможность редактировать «дату» и «направление границы», и я сохранил эти 3 части в ThisWorkbook.Worksheets("Help").Range("A1:A1")
, ThisWorkbook.Worksheets("Help").Range("A2:A2")
и ThisWorkbook.Worksheets("Help").Range("A3:A3")
.
Все возможные «границы границ» хранятся в именованном диапазоне 2x2 seecaoBordersArray
. Код перебирает этот диапазон, создает соответствующее тело запроса, отправляет запрос и получает ответ.

Ответ в формате JSON. Интересующий меня ответ - это HTML-таблица, расположенная в строке JSON.
Затем строка JSON анализируется для получения таблицы HTML. Наконец, таблица HTML анализируется, и интересующие данные записываются на листе.

Как я уже говорил в начале этого поста, код работает в большинстве случаев, как и ожидалось, но случайным образом вылетает с Automation Error
в зависимости от того, сколько итераций выполняется.
Например, он никогда не падает, когда я выполняю его только для 2 комбинаций «границ направлений».
Мне кажется, что это проблема производительности, а не ошибка.
Будем весьма благодарны за любые предложения о том, как улучшить производительность и избежать этих сбоев.