html提取的VBA问题

Question

我在此处获取此代码，用于将网站中的表格中的信息转换为 VBA Excel 中的传播。这里是 URL http://www.racingpost.com/greyhounds/dog_home.sd?dog_id=1

这个想法是遍历 ID 以将配置文件下载到工作表上。 该程序使用该站点的底层 HTML 代码。该代码在某种程度上似乎运行良好，但我对 HTML 的理解不佳可能是问题所在 到目前为止，我已经成功下载了以下字段。 dogName,dateofbirth,trainerName,date(race),track,dis,fin,pos,split,remarks,time.. 我遇到困难的领域是 trp,by,win/sec,going,price,grd 和 calc 下面是来自站点的带有相应 HTML 的字段名称：这些是我无法检索的字段：

trp                <td class="center">[2]</td>
by                 <td>12<td>
going              <td class="center">+10</td>
price              <td class="center">5/1</td>
grd                <td class="center">A2</td> 
calc               <td class="center">24.01</td> 

 win/sec is a href link
 <a href="http://www.racingpost.com/greyhounds/dog_home.sd?dog_id=39894" onclick="return Html.popup(this, {width:800, height:480})" title="Click for Dog Form...">KAL RY TAZ</a> 

代码如下：

Option Explicit
 Sub GetTrackData()
    Dim response As String
    Dim dogHomeUrl As String
    Dim dogFormUrl As String
    Dim i As Long
    Dim x As Long
    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 7
    response = XmlHttpRequest(dogHomeUrl & i)
    Debug.Print (response)

    loc1 = InStr(response, "popUpHead")
    loc1 = InStr(loc1, response, "<h1>") + 4
    loc2 = InStr(loc1, response, "</h1>")


    dogName = Trim(Mid(response, loc1, loc2 - loc1))

    If dogName <> "" Then
        'this is the code that hgets the data from the top of the page
        loc1 = InStr(loc2, response, "<li>")
        loc1 = InStr(loc1, response, "(") + 1
        loc2 = InStr(loc1, response, ")")
        dogDate = Trim(Mid(response, loc1, loc2 - loc1))

        loc1 = InStr(loc2, response, "<strong>Trainer</strong>") + 24
        loc2 = InStr(loc1, response, "</li>")
        trainer = Trim(Mid(response, loc1, loc2 - loc1))
        response = XmlHttpRequest(dogFormUrl & i)




        loc1 = InStr(response, "Full Results")
        Do While (loc1 <> 0)
            Dim raceDate As String
            Dim raceTrack As String
            Dim raceDis As String
            Dim raceTrp As String
            Dim raceSplit As String
            Dim raceFin As String
            Dim raceBy As String
            Dim racePos As String
            Dim raceRemarks As String
            Dim raceWinSec As String
            Dim raceTime As String
            Dim raceGoing As String
            Dim racePrice As String
            Dim raceGrd As String
            Dim raceCalc As String

            'next is the code I have used to extract the fields
            'so far I have managed the 8 field below out of the table
            'having already got dogname,date and trainer above.
            'I have tried different variations of these code block 
            ' but I think my grasp of html is not sufficent to crack it
            'any help appreciated.  


            'this is the code that gets the data from the  table
            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))

            loc1 = InStr(loc2, response, "<td>") + 25
            loc2 = InStr(loc1, response, "</td>") - 7
            raceDis = Trim(Mid(response, loc1, loc2 - loc1))

           loc1 = InStr(loc2, response, "<td>") + 4
           loc2 = InStr(loc1, response, "</td>")
           racePos = Trim(Mid(response, loc1, loc2 - loc1))

           loc1 = InStr(loc2, response, "<td>") + 4
           loc2 = InStr(loc1, response, "</td>")
           raceSplit = Trim(Mid(response, loc1, loc2 - loc1))

           loc1 = InStr(loc2, response, "<td>") + 25
           loc2 = InStr(loc1, response, "</td>") - 7
           raceFin = Trim(Mid(response, loc1, loc2 - loc1))


          loc1 = InStr(loc2, response, "i>") + 2
          loc2 = InStr(loc1, response, "</i>")
          raceRemarks = Trim(Mid(response, loc1, loc2 - loc1))


         loc1 = InStr(loc2, response, "<td>") + 24
           loc2 = InStr(loc1, response, "</td>") - 7
           racePrice = 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 = raceDis
            Range("G" & x).Value = raceTrp
            Range("H" & x).Value = raceFin
            Range("I" & x).Value = raceSplit
            Range("J" & x).Value = raceWinSec
            Range("K" & x).Value = racePos
            Range("L" & x).Value = raceRemarks
            Range("M" & x).Value = raceGoing
            Range("N" & x).Value = raceTime
            Range("O" & x).Value = raceBy
            Range("M" & x).Value = racePrice
            Range("N" & x).Value = raceGrd
            Range("O" & x).Value = raceCalc







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


    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

非常感谢任何帮助 科林（吉米）

Answer 1

Excel 可以得到它自己的网页，不需要你的帮助。

将每一页粘贴到一张空白纸上，然后参考主纸上的单元格。

Alt + D(ata), Get External )D(ata), (New)W(eb Query) 指定参数.