Полный HTML-код страницы, не возвращенный ответом XML

Question

Я пытаюсь свести статистику игроков в теннис с этого сайта в документ Excel для удобства просмотра: http://www.tennisabstract.com/cgi-bin/player.cgi?p=DominicThiem (пример игрока).

Я уже несколько раз проверял VBA, так что я не совсем новичок в этом, но я знаю, что эта проблема, скорее всего, связана с моей нехваткой знаний, чем с внутренней проблемойприложения, которые я использую!Когда я debug.print внутренний HTML вышеупомянутой веб-страницы, HTML-код не совпадает с тем, когда я проверяю элемент на странице.Это полный HTML-код, возвращаемый скребком, который явно не завершен:

<TABLE width=1280>
<TBODY>
<TR>
<TD align=left>This site is slow and ugly in Internet Explorer. In <A href="https://www.google.com/intl/en/chrome/browser/">Chrome</A> or <A href="http://www.mozilla.org/en-US/firefox/new/">Firefox</A>, it is much faster and a bit less ugly.<BR>&nbsp;</TD>
<TD align=right><A href="http://www.tennisabstract.com/blog">HeavyTopspin.com</A> | <A href="https://twitter.com/#!/tennisabstract">Twitter</A> </TD></TR></TBODY></TABLE>
<DIV id=header>
<TABLE width=1240>
<TBODY>
<TR>
<TD class=headline align=left>
<H1><SPAN class=blackheader><A href="http://www.tennisabstract.com/">tennis<SPAN style="COLOR: blue">abstract</SPAN>.com</SPAN></H1></A></TD>
<TD id=playersearch style="VERTICAL-ALIGN: top" align=right>&nbsp;</TD></TR>
<TR>
<TD>&nbsp;</TD>
<TD>&nbsp;</TD></TR>
<TR>
<TD style="VERTICAL-ALIGN: top" align=left><SPAN id=bio>&nbsp;</SPAN> <SPAN id=tabResults class=tabview style="BACKGROUND-COLOR: #e6eeee">&nbsp;<B>Singles Results</B>&nbsp;</SPAN>&nbsp; <SPAN id=tabHead class="tablink tabview" style="BACKGROUND-COLOR: #e6eeee">&nbsp;<B>Head-to-Heads</B>&nbsp;</SPAN>&nbsp; <SPAN id=tabEvents class="tablink tabview" style="BACKGROUND-COLOR: #e6eeee">&nbsp;<B>Event Records</B>&nbsp;</SPAN> <BR><SPAN id=tabDubs class="tablink tabview" style="POSITION: relative; TOP: 5px; BACKGROUND-COLOR: #e6eeee">&nbsp;<B>Doubles Results</B>&nbsp;</SPAN><SPAN id=tabDubsSpacer>&nbsp;&nbsp;</SPAN> <SPAN id=shotsHere></SPAN></TD>
<TD id=wonloss style="VERTICAL-ALIGN: top" align=right>&nbsp;</TD></TR>
<TR>
<TD id=tabmenu style="VERTICAL-ALIGN: top" align=left>&nbsp; </TD>
<TD>&nbsp;</TD></TR>
<TR>
<TD id=playernews colSpan=2>&nbsp;</TD></TR></TR></TBODY></TABLE></DIV>
<DIV id=main>
<TABLE id=maintable width=1280>
<TBODY>
<TR id=tabletoggles>
<TD>&nbsp;</TD>
<TD id=tablelabel>&nbsp;</TD>
<TD id=abovestats class=abovestats align=right>&nbsp;&nbsp;&nbsp;<SPAN class="revscore likelink"></SPAN> &nbsp;&nbsp;&nbsp;<B>Stats:</B>&nbsp; <SPAN class="statsa stattab">Overview</SPAN><SPAN class=statspacer>&nbsp;|&nbsp;</SPAN><SPAN class="statso stattab">Serve</SPAN>&nbsp;|&nbsp;<SPAN class="statsr stattab likelink">Return</SPAN>&nbsp;|&nbsp;<SPAN class="statsw stattab likelink">Raw</SPAN> </TD></TR>
<TR>
<TD id=footer class=footer>&nbsp;</TD>
<TD id=stats class=stats colSpan=2>
<TABLE id=matches>
<TBODY></TBODY></TABLE></TD></TR>
<TR>
<TD id=belowmenus>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;<BR>&nbsp;</TD>
<TD id=belowmatches colSpan=2>&nbsp;</TD></TR></TBODY></TABLE></DIV>
<DIV></DIV>

Я пытаюсь почистить «главную» таблицу в нижней половине страницы, которая показывает последние совпадения игрока(id = "соответствует", 6-я строка снизу приведенного выше HTML).Когда я проверяю элемент на самой веб-странице, таблица выглядит так, что ее очень легко очистить, но мой отчет не возвращает полный HTML, поэтому я не могу ссылаться на что-либо в своем коде.

Iпосчитал, что это может быть связано с тем, что мой XML не загружается полностью, поэтому попытался this , который возвращает тот же HTML.

Вот код, который я использую до сих пор:

Sub TennisStats()

    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument

    Application.ScreenUpdating = False

    player1 = ThisWorkbook.Worksheets(1).Range("B1").Value
    player1 = Replace(player1, " ", "")

    With XMLPage
        .Open "GET", "http://www.tennisabstract.com/cgi-bin/player.cgi?p=" & player1
        .send

        HTMLDoc.body.innerHTML = .responseText

    End With

    Debug.Print HTMLDoc.body.innerHTML

End Sub

Answer 1

Вы не можете использовать XMLHTTP, так как нет времени для загрузки данных.

Кроме того, мне не хотелось работать с IE, используя Internet Controls, поэтому я переключилсяХром с использованием селена основной.Если вы устанавливаете selenium basic , вам также нужно перейти в VBE> Инструменты> Ссылки> Добавить ссылки в Selenium Type Library.Selenium поддерживает различные браузеры, включая FireFox, Chrome, IE и Opera.

Если вы используете Chrome, убедитесь, что у вас установлена ​​последняя версия Chrome, а также последняя версия ChromeDriver и что ChromeDriver.exe находится впапка, которая находится на пути к среде, если вы не хотите передать путь к исполняемому файлу в качестве аргумента для selenium.

Option Explicit
Public Sub GetTable()
    Dim d As WebDriver, html As HTMLDocument, hTable As HTMLTable
    Set d = New ChromeDriver: Set html = New HTMLDocument
    Const URL = "http://www.tennisabstract.com/cgi-bin/player.cgi?p=DominicThiem"

    With d
        .Start "Chrome"
        .get URL
        html.body.innerHTML = .PageSource
        Set hTable = html.getElementById("matches")
        WriteTable hTable, 1, ThisWorkbook.Worksheets("Sheet1")
        .Quit
    End With
End Sub
Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet
    Dim tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long
    r = startRow
    With ws
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            columnCounter = columnCounter + 1
            .Cells(startRow + 1, columnCounter) = header.innerText
        Next header
        Set tRow = hTable.getElementsByTagName("tr")
        For Each tr In tRow
            r = r + 1
            Set tCell = tr.getElementsByTagName("td")
            c = 1
            For Each td In tCell
                Select Case c
                Case 16
                    .Cells(r, c).Value = "'" & td.innerText
                Case Else
                    .Cells(r, c).Value = td.innerText
                End Select
                c = c + 1
            Next td
        Next tr
    End With
End Sub

---

Пример представления веб-страницы:

---

Образец выхода селена: