Как ускорить парсер VBA с помощью MSXML2.XMLHTTP вместо InternetExplorer.Application

Я только начал изучать VBA пару недель назад, поэтому прошу прощения, если в моей работе есть очевидные ошибки. Я написал код, который успешно извлекает данные из таблиц на веб-сайте, но проблема в том, что он работает очень медленно. Я знаю, что использование internetexplorer.application — довольно медленный способ очистки веб-сайтов, а более быстрый способ — использовать MSXML2.XMLHTTP.

Итак, я пытаюсь преобразовать свой текущий код для использования MSXML2.XMLHTTP вместо internetexplorer.application, но, похоже, я все испортил. Я просмотрел довольно много вопросов, но, похоже, у меня возникли проблемы с использованием таких вещей, как .getElementsByTagName.

Вот мой код internetexplorer.application, который я хочу преобразовать в MSXML2.XMLHTTP.

Sub macro6()

Dim internet As InternetExplorer

Dim internetdata As HTMLDocument

Dim internetlink As Object
Dim bbb As Long
Dim internetinnerlink As Object
Dim LR As Long
    LR = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
Dim LR2 As Long
    LR2 = Sheets("Sheet1").Range("H" & Rows.Count).End(xlUp).Row + 1
Dim LC As Long
    LC = Sheets("Sheet1").Cells(2, Columns.Count).End(xlToLeft).Column + 1
Dim y As Long


For bbb = 1 To (LR - 1)
Set internet = CreateObject("InternetExplorer.Application")


internet.Visible = False

internet.navigate ("http://data.nowgoal.com/3in1odds/31_" & Sheets("Sheet1").Range("c1").Offset(bbb, 0)) & ".html"

Do While internet.Busy

  DoEvents

Loop

Do Until internet.READYSTATE = READYSTATE_COMPLETE

  DoEvents

Loop

Set internetdata = internet.document
For y = 2 To 4

hg_blue = internetdata.getElementsByTagName("tbody")(y).getElementsByClassName("hg_blue").Length + 1
hg_red = internetdata.getElementsByTagName("tbody")(y).getElementsByClassName("hg_red").Length
hg_green = internetdata.getElementsByTagName("tbody")(y).getElementsByClassName("hg_green").Length

xx = hg_blue + 1
yy = hg_blue + hg_red
zz = hg_blue + hg_red + hg_green

If zz > 1 Then

    Set internetlink = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(xx).getElementsByTagName("td")
    Set internetlink2 = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(yy).getElementsByTagName("td")
    Set internetlink3 = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(zz).getElementsByTagName("td")


    For Each internetinnerlink In internetlink
    Sheets("Sheet1").Cells(LR2, LC) = internetinnerlink.innerText

    LC = LC + 1
    Next internetinnerlink


    For Each internetinnerlink In internetlink2
    Sheets("Sheet1").Cells(LR2, LC) = internetinnerlink.innerText

    LC = LC + 1
    Next internetinnerlink


    For Each internetinnerlink In internetlink3
    Sheets("Sheet1").Cells(LR2, LC) = internetinnerlink.innerText

    LC = LC + 1
    Next internetinnerlink

Else

    Set internetlink = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(1).getElementsByTagName("td")
    Set internetlink2 = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(1).getElementsByTagName("td")
    Set internetlink3 = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(1).getElementsByTagName("td")


    For Each internetinnerlink In internetlink
    Sheets("Sheet1").Cells(LR2, LC) = ""

    LC = LC + 1
    Next internetinnerlink


    For Each internetinnerlink In internetlink2
    Sheets("Sheet1").Cells(LR2, LC) = ""

    LC = LC + 1
    Next internetinnerlink


    For Each internetinnerlink In internetlink3
    Sheets("Sheet1").Cells(LR2, LC) = ""

    LC = LC + 1
    Next internetinnerlink

End If

Next y
LR2 = LR2 + 1
LC = Sheets("Sheet1").Cells(LR2, Columns.Count).End(xlToLeft).Column + 1

internet.Quit
Next bbb


End Sub

Данные в столбце C — это числа 1274444 в C2, 1274445 в C3, 1274446 в C4 и т. д.

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


person P McC    schedule 26.04.2017    source источник
comment
Вы можете посмотреть мой ответ здесь, чтобы увидеть использование MSXML2.XMLHTTP. С его помощью вы можете легко преобразовать свой код в MSXML2.XMLHTTP.   -  person Tehscript    schedule 26.04.2017
comment
Веб-скрейпинг с XHR позволяет достичь более высокой производительности без использования методов DOM, чем существенно отличается от автоматизации IE. Специально для AJAX/DHTML.   -  person omegastripes    schedule 26.04.2017