26th January 2012, 09:36 PM
|
Member
|
|
Join Date: Sep 2006
Posts: 18
|
|
This code includes the error handling for scratched horses
Hopefully this resolves your issue. I am also ripping this data from Unitab and it returns and processes it really fast in Excel. Combine it with a 'pull' of the Meetings List from Tab Racing's Live Odds Web Service and you can build a really quick tree navigation list box that can be used to get each race's details from Unitab's XML feed very efficiently and cleanly.
Code:
Sub LoadRaceOdds()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim xmldoc As MSXML2.DOMDocument
Dim RaceDate As String
Dim RaceNumber As String
RaceDate = Worksheets("RaceCard").Range("A3").Text
RaceNumber = Worksheets("RaceCard").Range("A4").Text
Set xmldoc = New MSXML2.DOMDocument
xmldoc.async = False
xmldoc.Load (" http://tatts.com/pagedata/racing/" & RaceDate & "/" & RaceNumber & ".xml")
If (xmldoc.parseError.ErrorCode <> 0) Then
MsgBox ("An error has occurred: " & xmldoc.parseError.reason)
Else
'Last Odds Displayed
Set runnerlastlist = xmldoc.SelectNodes("//Runner/WinOdds")
Worksheets("Racecard").Range("b2:25").ClearContents
For I = 0 To (runnerlastlist.Length - 1)
Set runner = runnerlastlist.Item(I)
Set runnerLastOdds = runner.Attributes.getNamedItem("Lastodds")
If Not runnerLastOdds Is Nothing Then
Sheet1.Cells(I + 2, 2) = runnerLastOdds.Text
End If
Next
'Win Odds Displayed
Set runnerwinoddslist = xmldoc.SelectNodes("//Runner/WinOdds")
Worksheets("Racecard").Range("c2:c25").ClearContents
For I = 0 To (runnerwinoddslist.Length - 1)
Set runner = runnerwinoddslist.Item(I)
Set runnerWinOdds = runner.Attributes.getNamedItem("Odds")
If Not runnerWinOdds Is Nothing Then
Sheet1.Cells(I + 2, 3) = runnerWinOdds.Text
End If
Next
Worksheets("Racecard").Activate
Range("c2:c25").Select
Selection.Replace What:="1638.30", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'PLACE ODDS DISPLAYED
Set runnerplaceoddslist = xmldoc.SelectNodes("//Runner/PlaceOdds")
Worksheets("Racecard").Range("d2:d25").ClearContents
For I = 0 To (runnerplaceoddslist.Length - 1)
Set runner = runnerplaceoddslist.Item(I)
Set runnerPlaceOdds = runner.Attributes.getNamedItem("Odds")
If Not runnerPlaceOdds Is Nothing Then
Sheet1.Cells(I + 2, 4) = runnerPlaceOdds.Text
End If
Next
Worksheets("Racecard").Range("d2:d25").Select
Selection.Replace What:="1638.30", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End Sub
|