excel - VBA Web 数据不显示整个表格

Question

我正在尝试将表格下载到 Excel 工作表中，然后循环到下一个表格。循环正在运行(虽然非常慢)，但我只显示页面顶部(前 5 行 Dog Name trainer名称等)并且主表没有出现。我还得到了 Cookie 消息。欢迎任何建议:

Option Explicit

Sub Macro1()


 Sheets("Sheet1").Select
  Range("A1").Select

    Dim i As Integer
    Dim e As integer
    Dim myurl As String, shorturl As String
    Sheets("Sheet1").Select

i = 1
Do While i < 3


 myurl = "URL;http://www.racingpost.com/greyhounds/dog_home.sd?dog_id=" & i & ""


  With ActiveSheet.QueryTables.Add(Connection:=myurl,   Destination:=Range("$A$1"))


  .Name = shorturl
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .PreserveFormatting = True
  .RefreshOnFileOpen = False
  .BackgroundQuery = True
  .RefreshStyle = xlInsertDeleteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .RefreshPeriod = 0
  .WebSelectionType = xlEntirePage
  .WebFormatting = xlWebFormattingNone
  .WebPreFormattedTextToColumns = True
  .WebConsecutiveDelimitersAsOne = True
  .WebSingleBlockTextImport = False
  .WebDisableDateRecognition = False
  .WebDisableRedirections = False
  .Refresh BackgroundQuery:=False
  .WebDisableDateRecognition = False
  .WebDisableRedirections = False
  .Refresh BackgroundQuery:=False
  End With

  Columns("A:J").Select
  Selection.Copy
  Range("K1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,   SkipBlanks _
  :=False, Transpose:=False
  Columns("A:J").Select
  Range("J1").Activate
  Application.CutCopyMode = False
  Selection.Delete Shift:=xlToLeft
  Columns("A:J").Select
  Selection.ColumnWidth = 20.01
  Columns("B:B").Select
  Selection.ColumnWidth = 20.01
  Rows("1:9").Select
  Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove




  i = i + 1

 Loop

End Sub

Answer 1

表格数据是在初始页面加载后通过ajax请求加载的。

如果您在 Chrome 中查看该页面并打开开发人员工具 (F12) -> Network 选项卡。您将看到针对以下 url 的附加请求:http://www.racingpost.com/greyhounds/dog_form.sd?dog_id=

您用来检索数据的方法很慢。加快速度的一种方法是通过 xmlhttprequest 请求 url，并自行解析您需要的相应数据。

以下是 xmlhttprequest 的示例(请注意，返回的数据是您可以解析的源代码字符串):

Function XmlHttpRequest(url As String) As String
    Dim xml As Object
    Set xml = CreateObject("MSXML2.XMLHTTP")
    xml.Open "GET", url, False
    xml.send
    XmlHttpRequest = xml.responseText
End Function

因此通过此方法请求数据将如下所示:

response = XmlHttpRequest("http://www.somesite.com")

这可能是我所知道的从网站检索数据最快的方法，因为它不涉及实际渲染任何内容。

然后，要解析任何给定的数据，您需要查找数据前面或后面与源中一致的内容。 (通常是具有特定类名或类似名称的 div)。通用解析可能如下所示:

loc1 = instr(response,"MyClassName")
loc1 = instr(loc1, response, ">") + 1 'the exact beginning of the data i'd like
loc2 = instr(loc1, response, "</td>")' the end of the data i'd like
data = trim(mid(response,loc1,loc2-loc1))

最后，这里是您可以粘贴以启动并运行某些内容的所有方法。我不确定您到底要查找哪些字段，因此我只是解析了每个页面中的一些字段作为示例:

Option Explicit
Sub GetTrackData()
    Dim response As String
    Dim dogHomeUrl As String
    Dim dogFormUrl As String
    Dim i As Integer
    Dim x As Integer
    Dim dogName As String
    Dim dogDate As String
    Dim trainer As String
    Dim breeding As String
    Dim loc1 As Long, loc2 As Long

    dogHomeUrl = "http://www.racingpost.com/greyhounds/dog_home.sd?dog_id="
    dogFormUrl = "http://www.racingpost.com/greyhounds/dog_form.sd?dog_id="
    x = 2
    For i = 1 To 10
        response = XmlHttpRequest(dogHomeUrl & i)
        Debug.Print (response)
        'parse the overall info

        'this is the basic of parsing the web page
        'just find the start of the data you want with instr
        'then find the end of the data with instr
        'and use mid to pull out the data we want
        'rinse and repeat this method for every line of data we'd like
        loc1 = InStr(response, "popUpHead")
        loc1 = InStr(loc1, response, "<h1>") + 4
        loc2 = InStr(loc1, response, "</h1>")
        dogName = Trim(Mid(response, loc1, loc2 - loc1))
        'apparantly if dog name is blank there is data to report on the web site
        If dogName <> "" Then
            'now lets get the dogDate
            loc1 = InStr(loc2, response, "<li>")
            loc1 = InStr(loc1, response, "(") + 1
            loc2 = InStr(loc1, response, ")")
            dogDate = Trim(Mid(response, loc1, loc2 - loc1))
            'now the trainer
            loc1 = InStr(loc2, response, "<strong>Trainer</strong>") + 24
            loc2 = InStr(loc1, response, "</li>")
            trainer = Trim(Mid(response, loc1, loc2 - loc1))

            response = XmlHttpRequest(dogFormUrl & i)
            'now we need to loop through the form table and parse out the values we care about
            loc1 = InStr(response, "Full Results")
            Do While (loc1 <> 0)
                Dim raceDate As String
                Dim raceTrack As String
                Dim dis As String

                loc1 = InStr(loc1, response, ">") + 1
                loc2 = InStr(loc1, response, "</a>")
                raceDate = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<td>") + 4
                loc2 = InStr(loc1, response, "</td>")
                raceTrack = Trim(Mid(response, loc1, loc2 - loc1))

                Range("A" & x).Value = dogName
                Range("B" & x).Value = dogDate
                Range("C" & x).Value = trainer
                Range("D" & x).Value = raceDate
                Range("E" & x).Value = raceTrack

                loc1 = InStr(loc2, response, "Full Results")
                x = x + 1
            Loop
            Debug.Print (response)
        End If
        'parse the form table

    Next i
End Sub
Function XmlHttpRequest(url As String) As String
    Dim xml As Object
    Set xml = CreateObject("MSXML2.XMLHTTP")
    xml.Open "GET", url, False
    xml.send
    XmlHttpRequest = xml.responseText
End Function

编辑 1

我们交互的数据是错误的，显然第一列并不总是链接。这是一个修改后的示例，其中正在解析更多字段。如果您有任何疑问，请告诉我:

Option Explicit
Sub GetTrackData()
    Dim response As String
    Dim dogHomeUrl As String
    Dim dogFormUrl As String
    Dim i As Integer
    Dim x As Integer
    Dim dogName As String
    Dim dogDate As String
    Dim trainer As String
    Dim breeding As String
    Dim loc1 As Long, loc2 As Long
    Dim qt As String
    qt = """"


    dogHomeUrl = "http://www.racingpost.com/greyhounds/dog_home.sd?dog_id="
    dogFormUrl = "http://www.racingpost.com/greyhounds/dog_form.sd?dog_id="
    x = 2
    For i = 1 To 10
        response = XmlHttpRequest(dogHomeUrl & i)
        Debug.Print (response)
        'parse the overall info

        'this is the basic of parsing the web page
        'just find the start of the data you want with instr
        'then find the end of the data with instr
        'and use mid to pull out the data we want
        'rinse and repeat this method for every line of data we'd like
        loc1 = InStr(response, "popUpHead")
        loc1 = InStr(loc1, response, "<h1>") + 4
        loc2 = InStr(loc1, response, "</h1>")
        dogName = Trim(Mid(response, loc1, loc2 - loc1))
        'apparantly if dog name is blank there is data to report on the web site
        If dogName <> "" Then
            'now lets get the dogDate
            loc1 = InStr(loc2, response, "<li>")
            loc1 = InStr(loc1, response, "(") + 1
            loc2 = InStr(loc1, response, ")")
            dogDate = Trim(Mid(response, loc1, loc2 - loc1))
            'now the trainer
            loc1 = InStr(loc2, response, "<strong>Trainer</strong>") + 24
            loc2 = InStr(loc1, response, "</li>")
            trainer = Trim(Mid(response, loc1, loc2 - loc1))

            response = XmlHttpRequest(dogFormUrl & i)
            'now we need to loop through the form table and parse out the values we care about
            loc1 = InStr(response, "<td class=" & qt & "first" & qt) + 17
            Do While (loc1 > 17)
                Dim raceDate As String
                Dim raceTrack As String
                Dim dis As String
                Dim trp As String
                Dim splt As String
                Dim pos As String
                Dim fin As String
                Dim by As String
                Dim winSec As String
                Dim remarks As String
                Dim time As String
                Dim going As String
                Dim price As String
                Dim grd As String
                Dim calc As String

                loc1 = InStr(loc1, response, ">") + 1
                loc2 = InStr(loc1, response, "</td>")
                raceDate = Trim(Mid(response, loc1, loc2 - loc1))
                If InStr(raceDate, "<a href") > 0 Then 'we have a link so parse out the date from the link
                    Dim tem1 As Long
                    Dim tem2 As Long
                    tem1 = InStr(raceDate, ">") + 1
                    tem2 = InStr(tem1, raceDate, "</a>")
                    raceDate = Trim(Mid(raceDate, tem1, tem2 - tem1))
                End If
                loc1 = InStr(loc2, response, "<td>") + 4
                loc2 = InStr(loc1, response, "</td>")
                raceTrack = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<td><span class=") + 16
                loc1 = InStr(loc1, response, ">") + 1
                loc2 = InStr(loc1, response, "</span>")
                dis = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<td class=")
                loc1 = InStr(loc1, response, ">") + 1
                loc2 = InStr(loc1, response, "</td>")
                trp = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<td>") + 4
                loc2 = InStr(loc1, response, "</td>")
                splt = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<td>") + 4
                loc2 = InStr(loc1, response, "</td>")
                pos = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<span class= " & qt & "black" & qt & ">") + 21
                loc2 = InStr(loc1, response, "</span>")
                fin = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<td>") + 4
                loc2 = InStr(loc1, response, "</td>")
                by = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<a href=") + 8
                loc1 = InStr(loc1, response, ">") + 1
                loc2 = InStr(loc1, response, "</a>")
                winSec = Trim(Mid(response, loc1, loc2 - loc1))
                '<td><i>
                loc1 = InStr(loc2, response, "<td><i>") + 7
                loc2 = InStr(loc1, response, "</i>")
                remarks = Trim(Mid(response, loc1, loc2 - loc1))
                '<span class="black">
                loc1 = InStr(loc2, response, "<span class=" & qt & "black" & qt & ">") + 21
                loc2 = InStr(loc1, response, "</span>")
                time = Trim(Mid(response, loc1, loc2 - loc1))
                '<td class="center">
                loc1 = InStr(loc2, response, "<td class=" & qt & "center" & qt & ">") + 19
                loc2 = InStr(loc1, response, "</td>")
                going = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<td class=" & qt & "center" & qt & ">") + 19
                loc2 = InStr(loc1, response, "</td>")
                price = Trim(Mid(response, loc1, loc2 - loc1))
                loc1 = InStr(loc2, response, "<td class=" & qt & "center" & qt & ">") + 19
                loc2 = InStr(loc1, response, "</td>")
                grd = Trim(Mid(response, loc1, loc2 - loc1))

                Range("A" & x).Value = dogName
                Range("B" & x).Value = dogDate
                Range("C" & x).Value = trainer
                Range("D" & x).Value = raceDate
                Range("E" & x).Value = raceTrack
                Range("F" & x).Value = dis
                Range("G" & x).Value = trp
                Range("H" & x).Value = splt
                Range("I" & x).Value = pos
                Range("J" & x).Value = fin
                Range("K" & x).Value = by
                Range("L" & x).Value = winSec
                Range("M" & x).Value = remarks
                Range("N" & x).Value = time
                Range("O" & x).Value = going
                Range("P" & x).Value = price
                Range("Q" & x).Value = grd

                loc1 = InStr(loc2, response, "<td class=" & qt & "first" & qt) + 17
                x = x + 1
            Loop
            Debug.Print (response)
        End If
        'parse the form table

    Next i
End Sub
Function XmlHttpRequest(url As String) As String
    Dim xml As Object
    Set xml = CreateObject("MSXML2.XMLHTTP")
    xml.Open "GET", url & "&cache_buster=" & GenerateRandom, False
    xml.send
    XmlHttpRequest = xml.responseText
End Function
Function GenerateRandom() As String
    GenerateRandom = Int(Rnd * 1000)
End Function