I got this code here for getting the info from a table in a website into a spread in VBA Excel.Here is the Url http://www.racingpost.com/greyhounds/dog_home.sd?dog_id=1
The idea is to loop through the ID's to downlaod the profiles onto the sheet. The program uses the underlying HTML code from the site.The code seems to work well to a point but my poorish understanding of HTML could be the problem So far I have succeeded in downloading the following fields. dogName,dateofbirth,trainerName,date(race),track,dis,fin,pos,split,remarks,time.. the fields I am having difficulty with are trp,by,win/sec,going,price,grd and calc Below is the field name with the corresponding HTML from the site:These are the fields I can't retrieve:
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>
Here is the code:
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
Any help greatly appreciated Colin(jimmy)
