Ошибка автоматизации Excel VBA при очистке веб-данных с сайта - PullRequest
1 голос
/ 15 марта 2019

Я создал приложение, которое очищает данные с веб-сайта.

Код выполняется, как ожидается, для небольшого числа итераций.

Однако, когда код выполняется несколько раз, он вылетает с 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. Код перебирает этот диапазон, создает соответствующее тело запроса, отправляет запрос и получает ответ.

seecaoBordersArray

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

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

Results printout

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

Например, он никогда не падает, когда я выполняю его только для 2 комбинаций «границ направлений».

Мне кажется, что это проблема производительности, а не ошибка.

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...