Question

我正在尝试将网球运动员的统计信息从此网站上刮到一个Excel文档中，以方便查看：http://www.tennisabstract.com/cgi-bin/player.cgi?p=DominicThiem（示例运动员）。

我以前使用VBA进行过几次刮擦，所以我对刮擦并不完全陌生，但是我知道这个问题很可能是由于我缺乏知识，而不是我的应用程序固有的问题。我正在使用！当我debug.print上面网页的内部HTML时，该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 =“ matches”，位于上述HTML底部的第六行）。当我检查网页本身上的元素时，表格看起来应该很容易刮擦，但是我的刮擦并没有返回完整的HTML，因此我无法在代码中引用任何内容。

我认为这可能是由于我的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，因为没有时间加载数据。

此外，它似乎也不想通过Internet Controls使用IE为我工作，因此我改用了Selenium basic。如果安装selenium basic，则还需要转到VBE>工具>引用>将引用添加到Selenium类型库。 Selenium支持多种浏览器，包括FireFox，Chrome，IE和Opera。

如果使用Chrome，请确保您已安装最新的Chrome和ChromeDriver install，并且ChromeDriver.exe位于环境路径下的文件夹中，除非您希望将路径以以下方式传递给可执行文件：硒的论点。

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

示例网页视图：

样品硒输出：

XML响应未返回页面的完整HTML

1 个答案: