Как оптимизировать метод ожидания с помощью VBA и Chromedriver

на этой домашней странице "http://www.kpia.or.kr/index.php/year_sugub"

Если вы проверите html, есть 6 идентификаторов от li1 до li6. Первое, что я заметил после первого использования chromedriver, это неэффективность метода ожидания. Поэтому я искал различные способы оптимизировать ожидание после нажатия в Интернете для использования на этой домашней странице. Например, я применил следующие три вида кодирования.

ex1) Приложение. Подождите сейчас + TimeSerial (0, 0, 5)

ex2) .FindElementById("li2", тайм-аут: = 10000) .Click

ex3) 'Do' DoEvents 'При ошибке Возобновить Далее' Установить ele = .FindElementById ("li2") 'При ошибке Перейти к 0 'Если Таймер - t = 10, Затем Выйти Выполнить' ‹== Во избежание бесконечного цикла 'Цикл, пока ele Is Ничего

Однако мы не смогли окончательно найти способ оптимизировать метод ожидания без использования Application.Wait Now + TimeSerial(0, 0, 5). Этот метод загружается не полностью после нажатия li2, но иногда выполняются дополнительные задачи.

Итак, я подумал о формальной логике кодирования, которую я мог бы время от времени использовать для написания аналогичного кода в будущем, и придумал следующую логику. Например, в li2 значение этилена всегда является фиксированным значением со значением результата, поэтому, если вы нажмете на li2, а затем найдете значение «SM», данные будут загружены на лист. Далее, «LDPE» в li3 — это способ вставки данных на лист после завершения загрузки. Итак, я кодирую эту идею и не могу решить ошибку, пока работаю над VBA.

Dim d As WebDriver, ws As Worksheet, clipboard As Object
Set d = New ChromeDriver
Set ws = ThisWorkbook.Worksheets("Sheet3")
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Const URL = "http://www.kpia.or.kr/index.php/year_sugub"
Dim html As HTMLDocument

Set html = New HTMLDocument

With d
    .AddArgument "--headless"
    .Start "Chrome"
    .get URL, Raise:=False
rep:
    .FindElementById("li2", timeout:=10000).Click

    Dim Posts As WebElements
    Dim elem As WebElements
    Dim a1 As Integer

    For Each Posts In .FindElementsByClass("bbs")
        For Each elem In Posts.FindElementsByCss("td")
            If Not elem.Text = "SM" Is Nothing Then

html.body.innerHTML = d.PageSource

Dim tarTable As HTMLTable
Dim hTable As HTMLTable

For Each tarTable In html.getElementsByTagName("table")
    If InStr(tarTable.className, "bbs") <> 0 Then
    Set hTable = tarTable
    End If
Next

    clipboard.SetText .FindElementById("table_body").Attribute("outerText")
    clipboard.PutInClipboard

    else
    goto rep
    end if
    .Quit

End With

Если он находит значение, совпадающее со значением SM, он предполагает, что загрузка завершена, и переходит к передаче соответствующих данных в буфер обмена. Если значение SM не найдено, используйте GOTO для использования .FindElementById (время ожидания "li2": = 10000). Я думал, что смогу исправить это, создав цикл, который перезапускается из .Click.

Я новичок в процессе экономии времени и усердного обучения во время чтения, поэтому я был бы очень признателен, если бы вы могли оказать мне дополнительную помощь.

введите здесь описание изображения


person 김기성    schedule 29.11.2018    source источник
comment
Эта строка If Not elem.Text = "SM" Is Nothing Then должна завершиться ошибкой, потому что только объекты могут иметь значение Nothing, а Not elem.Text = "SM" — логическое значение. Этот код работает?   -  person TinMan    schedule 29.11.2018
comment
Железный человек. я вижу. спасибо ваш комментарий. Я попробую   -  person 김기성    schedule 30.11.2018


Ответы (1)


Я бы вообще не использовал браузер и выдавал запрос XMLHTTP POST и анализировал ответ XML для записи на лист. Сделайте это в цикле над кодами gubun, которые охватывают каждую вкладку, т. е. gubun = от 1 до 6.

Option Explicit

Public Sub GetTable()
    Dim sResponse As String, body As String, columnToWriteOut As Long, gubunNumber As Long
    Dim xmlDoc As Object

    Set xmlDoc = CreateObject("MSXML2.DOMDocument") 'New MSXML2.DOMDocument60
    columnToWriteOut = 1

    With CreateObject("MSXML2.XMLHTTP")

        For gubunNumber = 1 To 6

            body = "gubun=" & CStr(gubunNumber)
            .Open "POST", "http://www.kpia.or.kr/index.php/year_sugub/get_year_sugub", False
            .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
            .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.3; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/66.0.3359.181 Safari/537.36"
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
            .setRequestHeader "Content-Length", Len(body)
            .send body
            sResponse = .responseText

            With xmlDoc
                .validateOnParse = True
                .setProperty "SelectionLanguage", "XPath"
                .async = False
                If Not .LoadXML(sResponse) Then
                    Err.Raise .parseError.ErrorCode, , .parseError.reason
                End If
            End With

            Dim startYear As Long, endYear As Long, numColumns As Long, numRows As Long, data()
            Dim node As Object, nextNode As Object, headers(), i As Long

            startYear = xmlDoc.SelectSingleNode("//rec/sy").Text
            endYear = xmlDoc.SelectSingleNode("//rec/ey").Text
            numRows = xmlDoc.SelectNodes("//product").Length

            ReDim headers(1 To endYear - startYear + 3)
            numColumns = UBound(headers)
            ReDim data(1 To numRows, 1 To numColumns)
            headers(1) = "Product": headers(2) = "Category"

            For i = 1 To endYear - startYear + 1
                headers(i + 2) = startYear + i - 1
            Next

            Dim r As Long, c As Long, rowCounter As Long

            rowCounter = 0
            For Each node In xmlDoc.SelectNodes("//rec")  ' '//rec/*[not(self::sy) and not(self::ey) and not(self::product)]  ?
                c = 1: rowCounter = rowCounter + 1
                For Each nextNode In node.ChildNodes
                    Select Case c
                    Case 3
                        data(rowCounter, 1) = nextNode.Text
                    Case Is > 3
                        data(rowCounter, c - 1) = nextNode.Text
                    End Select

                    Select Case rowCounter Mod 4
                    Case 1
                        data(rowCounter, 2) = "Production (shipment)"
                    Case 2
                        data(rowCounter, 2) = "Export"
                    Case 3
                        data(rowCounter, 2) = "income"
                    Case 0
                        data(rowCounter, 2) = "Domestic demand "
                    End Select
                    c = c + 1
                Next
            Next

            With ThisWorkbook.Worksheets("Sheet1")
                .Cells(1, columnToWriteOut).Resize(1, UBound(headers)) = headers
                .Cells(2, columnToWriteOut).Resize(UBound(data, 1), UBound(data, 2)) = data
            End With
            columnToWriteOut = columnToWriteOut + UBound(headers) + 2
        Next
    End With
End Sub

В качестве альтернативы вы можете зациклить ожидание завершения каждого вызова Ajax:

Option Explicit

Public Sub GetInfo()
    Dim d As WebDriver, ws As Worksheet, clipboard As Object, writeOutColumn As Long
    writeOutColumn = 1
    Const URL = "http://www.kpia.or.kr/index.php/year_sugub"

    Set d = New ChromeDriver
    Set ws = ThisWorkbook.Worksheets("Sheet3")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    With d
        .Start "Chrome"
        .get URL

        Dim links As Object, i As Long
        Set links = .FindElementsByCss("[href*=action_tab]")

        For i = 1 To links.Count
            If i > 1 Then
                links(i).Click
                Do
                Loop While Not .ExecuteScript("return jQuery.active == 0")
            End If
            Dim table As Object
            Set table = .FindElementByTag("table")
            clipboard.SetText table.Attribute("outerHTML")
            clipboard.PutInClipboard

            ws.Cells(1, writeOutColumn).PasteSpecial
            writeOutColumn = writeOutColumn + table.FindElementByTag("tr").FindElementsByTag("td").Count + 2
            Set table = Nothing
        Next
        .Quit
    End With
End Sub
person QHarr    schedule 29.11.2018
comment
QХарр. спасибо !! У меня есть два вопроса после подтверждения вашего ответа. Во-первых, Content-Length, Len (тело).. В этом предложении я не понимаю, зачем вставлять len (тело). Во-вторых, я не понимаю, почему .ExecuteScript (return jQuery.active == 0) был написан именно так. Это потому, что php использовался на kpia.or.kr/index.php? Или, если я смотрю на html, я не могу напрямую увидеть адрес данных xml, но вместо этого я нашел $ .ajaxSetup ({dataType: text}); Мне интересно, можно ли загружать данные в формате ajax с помощью jQuery.active == 0. - person 김기성; 30.11.2018
comment
Код, который вы написали, работает настолько хорошо, что впечатляет. Я только что подтвердил содержание, которое вы написали, и оставил сообщение. - person 김기성; 30.11.2018
comment
При использовании вкладки сети инструментов разработчика для просмотра веб-трафика при обновлении этой страницы запрос, который предоставляет эту информацию, включает len. Я просто подражал этому. Можно и без него попробовать. Там же фиксируется адрес данных XML. Страница использует AJAX для обновления содержимого при переключении вкладок. Этот .ExecuteScript (возврат jQuery.active == 0) отслеживает завершение обновления AJAX. Установка Not означает зацикливание до завершения. Это был самый надежный метод, который я смог найти для оптимизации ожидания, так как это означает, что контент загрузился. - person QHarr; 30.11.2018
comment
Я понял достаточно. Как вы упомянули, я подтвердил, что он работает хорошо, несмотря на удаление длины содержимого. Кстати, что означает If-Modified-Since, Sat, 1 Jan 2000 00:00:00 GMT? Это то, что невозможно проверить даже на вкладке сети, поэтому мне интересно, что значит вставлять этот контент. - person 김기성; 30.11.2018
comment
Вы также можете удалить. Я использую для смягчения последствий получения кэшированных ответов. На самом деле проблема только с очень часто обновляемым веб-контентом, например. живые цены на акции. Включил по привычке. - person QHarr; 30.11.2018