LIVE ODDS

[alrodopial]

Excel worksheet

[yursaduian]

Yes, my own Excel spreadsheet

[mak]

Well, I think Aldorpial asking you which specific excel file because he might be able to help you further...

Moreover, if what you do is winning you money, I would strongly suggest to get someone to code you an excel bot from scratch, in order to be able to update the code whenever is necessary

[yursaduian]

Thanks - and help is what I need, but I honestly don't know what file I'm using.

I played around with excel a couple of years ago using BA to get the betfair feed (my limit is writing an "if/and" function)

Then I asked about getting a feed for the on course odds and Gary wrote a code for me that obtains the live odds in decimal and fractional odds from sportinglife and was exactly what I was looking for and I've used it ever since.

Lately, for some reason, and I have no idea why, the live odds feed has become very intermittent and unreliable - and that's as much as I know.

Without those figs coming through I'm totally stumped but have no idea how to fix things

[alrodopial]

If I remember correctly Garry had made a file downloading SportigLifes' odds
Is this the one you are using or is it a custom one?
Without seeing the code no one can help you

[yursaduian]

I really don't know.

Gary provided me with a code and I copied and pasted it into my worksheet. That's as much as I know

If anyone could take a look I'd be grateful but what would they need to see?

I'm not being difficult, It's just that computer code is all Greek to me

[yursaduian]

I really don't know.

Gary provided me with a code and I copied and pasted it into my worksheet. That's as much as I know

If anyone could take a look I'd be grateful but what would they need to see?

I'm not being difficult, It's just that computer code is all Greek to me

[alrodopial]

post the code here or the file and maybe we can help you

[alrodopial]

It's just that computer code is all Greek to me

I'm Greek

[yursaduian]

Oh yes, so I see.

Well your English is better than my Greek - that much I do know!

[yursaduian]

alrodopial, thanks again for your interest.

I'm out today - hottest day this year, beach and all that but I'll post up what I'm using as soon as I'm allowed back indoors

[yursaduian]

Ok alrodopial, here goes.

This is the code I'm using, which is actually stopping and starting as I write this.

I hope it makes sense to you mate

Option Explicit

Dim liveShowURLS() As String
Dim liveShowRaceTimes() As String
Dim urlsLoaded As Boolean
Dim liveShowHTML As String, liveShowLastCaptured As Date

Private Sub getLiveShowURLS()
Dim t As String, p1 As Long, p2 As Long, c As Long
Dim dayStr As String
dayStr = Format(Now, "dd-mm-YYYY")
c = -1
t = getPage("http://www.sportinglife.com/racing")
p1 = 1
Do
p1 = InStr(p1, t, "option value=""/racing/racecards/" & dayStr)
If p1 <> 0 Then
p1 = p1 + 14
p2 = InStr(p1, t, Chr(34))
c = c + 1
ReDim Preserve liveShowURLS(c)
ReDim Preserve liveShowRaceTimes(c)
liveShowURLS(c) = "http://www.sportinglife.com" & Mid(t, p1, p2 - p1) & "/shows"
p2 = InStr(p2, t, ":")
If p2 <> 0 Then liveShowRaceTimes(c) = Mid(t, p2 - 2, 5) Else liveShowRaceTimes(c) = ""
Debug.Print liveShowURLS(c) & " " & liveShowRaceTimes(c)
End If
Loop Until p1 = 0
urlsLoaded = True
End Sub

Public Function getLiveShow(horseSearch As String, raceName As String) As Double
If Not urlsLoaded Then getLiveShowURLS
Dim i As Integer, t As String, t1 As String, p1 As Long, p2 As Long, raceTimeSearch As String
Dim odds As String, decimalOdds As Double
Dim timeDiff As Double
Dim f() As String
p1 = InStr(raceName, ":")
If p1 <> 0 Then raceTimeSearch = Mid(raceName, p1 - 2, 5) Else Exit Function
getLiveShow = 0
horseSearch = UCase(Replace(horseSearch, "'", ""))
For i = 0 To UBound(liveShowURLS)
If liveShowRaceTimes(i) = raceTimeSearch Then
timeDiff = DateDiff("s", liveShowLastCaptured, Now)
If timeDiff <> 0 Then
t = getPage(liveShowURLS(i))
Else
t = liveShowHTML
End If
liveShowHTML = t
liveShowLastCaptured = Now
p1 = InStr(Replace(UCase(t), "'", ""), ">" & horseSearch & "<")
If p1 <> 0 Then
p2 = InStr(p1, t, "</tr>")
If p2 <> 0 Then
t1 = Mid(t, p1, p2 - p1)
p1 = InStr(t1, "<strong class=""sortme"">")
If p1 <> 0 Then
p1 = p1 + 23
p2 = InStr(p1, t1, "<")
odds = Trim(Mid(t1, p1, p2 - p1))
If odds <> "Evs" Then
f = Split(odds, "/")
If UBound(f) = 0 Then
decimalOdds = Val(f(0)) + 1
Else
decimalOdds = Math.Round((Val(f(0)) / Val(f(1))) + 1, 2)
End If
Else
decimalOdds = 2
End If
End If
End If
End If
End If
Next
getLiveShow = decimalOdds
End Function

Public Function getLiveShowOld(horseSearch As String, raceName As String) As Double
If Not urlsLoaded Then getLiveShowURLS
Dim r As Integer, i As Integer, t As String, p1 As Long, p2 As Long, j As Integer, p As Integer
Dim horse As String, course As String, raceTime As String, odds As String, nonRunner As Boolean
Dim horseNr As String, raceDate As String, raceDistance As String, eventName As String
Dim firstShow As Double, lastShow As Double, movement As Boolean, raceTimeSearch As String
Dim f() As String
Dim fName As String
Dim timeDiff As Double
r = 1
p1 = InStr(raceName, ":")
If p1 <> 0 Then raceTimeSearch = Mid(raceName, p1 - 2, 5) Else Exit Function
getLiveShowOld = 0
horseSearch = UCase(Replace(horseSearch, "'", ""))
For i = 0 To UBound(liveShowURLS)
If liveShowRaceTimes(i) = raceTimeSearch Then
timeDiff = DateDiff("s", liveShowLastCaptured, Now)
If timeDiff <> 0 Then
t = getPage(liveShowURLS(i))
Else
t = liveShowHTML
End If
liveShowHTML = t
liveShowLastCaptured = Now
p1 = 1
Do
nonRunner = False
p1 = InStr(p1, t, "<!-- HORSE_NUMBER_")
If p1 <> 0 Then
p1 = InStr(p1, t, ">") + 1
p2 = InStr(p1, t, "<")
horseNr = Mid(t, p1, p2 - p1)
p1 = InStr(p1, t, "<!-- HORSE_NAME -->")
p1 = p1 + 19
p2 = InStr(p1, t, "<")
horse = Mid(t, p1, p2 - p1)
horse = UCase(Replace(horse, "'", ""))
p = InStr(horse, "(")
If p <> 0 Then horse = Left(horse, p - 2)
r = r + 1
firstShow = 0
lastShow = 0
movement = False
For j = 0 To 4
p1 = InStr(p1, t, "align=""right""")
p1 = p1 + 14
p2 = InStr(p1, t, "<")
If p2 > p1 Then
odds = Mid(t, p1, p2 - p1)
If odds <> "&nbsp;" Then
movement = True
If firstShow = 0 Then
'odds = getFirstLiveShow(horse)
If odds <> "evens" Then
f = Split(odds, "-")
If UBound(f) = 0 Then
firstShow = Val(f(0)) + 1
Else
firstShow = Math.Round((Val(f(0)) / Val(f(1))) + 1, 2)
End If
Else
firstShow = 2
End If
End If
End If
Else
nonRunner = True
Exit For
End If
Next
If Not nonRunner Then
p1 = InStr(p1, t, "last_show")
If p1 <> 0 Then
p1 = p1 + 11
p2 = InStr(p1, t, "<")
odds = Mid(t, p1, p2 - p1)
If odds <> "&nbsp;" Then
If odds <> "evens" Then
f = Split(odds, "-")
If UBound(f) = 0 Then
lastShow = Val(f(0)) + 1
Else
lastShow = Math.Round((Val(f(0)) / Val(f(1))) + 1, 2)
End If
Else
lastShow = 2
End If
If horse = horseSearch Then getLiveShowOld = lastShow
End If
End If
End If
End If
Loop Until p1 = 0
r = r + 1
End If
Next
End Function

Public Function getLiveShowFractional(horseSearch As String, raceName As String) As String
If Not urlsLoaded Then getLiveShowURLS
Dim i As Integer, t As String, t1 As String, p1 As Long, p2 As Long, raceTimeSearch As String
Dim odds As String, decimalOdds As Double
Dim timeDiff As Double
Dim f() As String
p1 = InStr(raceName, ":")
If p1 <> 0 Then raceTimeSearch = Mid(raceName, p1 - 2, 5) Else Exit Function
getLiveShowFractional = ""
horseSearch = UCase(Replace(horseSearch, "'", ""))
For i = 0 To UBound(liveShowURLS)
If liveShowRaceTimes(i) = raceTimeSearch Then
timeDiff = DateDiff("s", liveShowLastCaptured, Now)
If timeDiff <> 0 Then
t = getPage(liveShowURLS(i))
Else
t = liveShowHTML
End If
liveShowHTML = t
liveShowLastCaptured = Now
p1 = InStr(Replace(UCase(t), "'", ""), ">" & horseSearch & "<")
If p1 <> 0 Then
p2 = InStr(p1, t, "</tr>")
If p2 <> 0 Then
t1 = Mid(t, p1, p2 - p1)
p1 = InStr(t1, "<strong class=""sortme"">")
If p1 <> 0 Then
p1 = p1 + 23
p2 = InStr(p1, t1, "<")
odds = Trim(Mid(t1, p1, p2 - p1))
If odds <> "Evs" Then
getLiveShowFractional = odds
Else
getLiveShowFractional = "Evens"
End If
End If
End If
End If
End If
Next
End Function

Private Function getPage(strUrl)
Dim web
Const WinHttpRequestOption_EnableRedirects = 6
Set web = Nothing
On Error Resume Next
Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
web.Option(WinHttpRequestOption_EnableRedirects) = True
web.Open "GET", strUrl, False
web.SetRequestHeader "REFERER", strUrl
web.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
web.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
web.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
web.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
web.setTimeouts 1000, 1000, 1000, 1000
web.Send
If web.Status = "200" Then
getPage = web.ResponseText
Else
getPage = ""
End If
End Function

[alrodopial]

It's Garrys code posted in the file he gave some time ago.
Replace the getLiveShowURLS sub with the one below and tell me if it is working.
It's a change I made a while back but I don't remember if I made another change in another sub
Test it and tell me if it's working

Code: Select all

Private Sub getLiveShowURLS()

    Dim t As String , p1 As Integer, p2 As Integer, c As Long
    Dim dayStr As String
    dayStr = Format(Now, "dd-mm-YYYY")
    c = -1
    t = getPage("http://www.sportinglife.com/racing/live-shows")
    p1 = 1
    Do
        p1 = InStr(p1, t, " <a href=" & Chr(34) & "/racing/live-shows/" & dayStr & "/")
        If p1 <> 0 Then
            p1 = p1 + 39
            p2 = InStr(p1, t, Chr(34))
            c = c + 1
            ReDim Preserve liveShowURLS(c)
            ReDim Preserve liveShowRaceTimes(c)
            liveShowURLS(c) = "http://www.sportinglife.com/racing/live-shows/" & dayStr & Mid(t, p1, p2 - p1)
            p2 = InStr(p1 - 300, t, ":")
            If p2 <> 0 Then liveShowRaceTimes(c) = Mid(t, p2 - 2, 5) Else liveShowRaceTimes(c) = ""
            Debug.Print liveShowURLS(c) & " " & liveShowRaceTimes(c)
        End If
    Loop Until p1 = 0
    urlsLoaded = True
End Sub

[yursaduian]

No sir

It just returns #VALUE! where the LIVESHOW fig should be

[yursaduian]

alrodopial, I really do appreciate you taking time out to have a look at this.

I wish I could help somehow - instead of sitting here all afternoon tearing my hair out