Race Class

[Ian1506]

Hi folks.
Is there a way that the race class and/or going can be included on the spreadsheet either thru BA or some other means. This question was asked back in March by someone else but there were no replies. Any help gratefully accepted.

Cheers Ian

[Captain Sensible]

Betfair don't include that info in their API or data feeds so you'd need to find some site that does, then use some regex to match up the race time/meeting to scrape out the class/going

[Ian1506]

Thanks Captain.
I believe SPortinglife have these details on their site for each race. I have no idea what a regex is or how to go about scraping. Is ther a template that you know of that I could use as a starting point to learn?
Cheers Ian

[Captain Sensible]

There's a sportinglife spreadsheet on the forum that grabbed and displayed the current shows against betfair odds here

http://gruss-software.co.uk/forum/viewtopic.php?t=2886

I guess that'd be as good a starting point as anywhere as it already links the market to BA so you wouldn't have to code that. You'd need to know a bit of VBA to amend the excel code to just strip out the race class.

[alrodopial]

Thanks Captain.
I believe SPortinglife have these details on their site for each race. I have no idea what a regex is or how to go about scraping. Is ther a template that you know of that I could use as a starting point to learn?
Cheers Ian

Take a look here , you may find it usefull, or google
http://forum.punterslounge.com/f23/gett ... ker-82160/

You can also search it here , you will find a bit of code here and there

[osknows]

Hello,

The code below will work. It goes in a MODULE and the following must be checked

1. MUST set a reference to Microsoft HTML Object Library
2. Assumes codename Sheet1

Code: Select all

Option Explicit

Private Sub GetRPClass()
Dim raceDateString As String, url As String, Racedatetoextract As Date
Dim html As String, meetings As Object, course As String, tempArr() As String
Dim singlemeeting As Object, writerow As Long
'*****MUST set reference MS HTML Object Library*****
Dim tempHTMLDoc As HTMLDocument                   '*
'*****MUST set reference MS HTML Object Library*****

    Racedatetoextract = Date 'Todays Date
   
    raceDateString = Format(Racedatetoextract, "yyyy-mm-dd")
    url = "http://www.racingpost.com/horses2/cards/home.sd?r_date=" & raceDateString
    html = ExecuteWebRequest(url)
   
    Set tempHTMLDoc = New HTMLDocument
    tempHTMLDoc.body.innerHTML = html

    Set meetings = tempHTMLDoc.getElementsByTagName("TR")
    writerow = 0
    For Each singlemeeting In meetings
        If InStr(1, singlemeeting.innerText, ":", vbTextCompare) = 0 Then
            course = Trim(Replace(Replace(singlemeeting.innerText, "ATR", vbNullString), "RUK", vbNullString))
        End If
       
        If InStr(1, singlemeeting.innerText, ":", vbTextCompare) > 0 Then
            writerow = writerow + 1
           
            tempArr = Split(singlemeeting.innerText, ":")
            If UBound(tempArr) = 1 Then
           
                With Sheet1 '**Change to whatever sheet you need**
                    .Range("A" & writerow).Value = FindString(singlemeeting.innerText, "[0-9]*:[0-9][0-9]", 0)
                    .Range("B" & writerow).Value = course
                    .Range("C" & writerow).Value = singlemeeting.innerText
                    .Range("D" & writerow).Value = FindString(singlemeeting.innerText, "Cl[1-7]", 0)
                End With
           
            End If
       
        End If
   
   
    Next singlemeeting


End Sub

Public Function ExecuteWebRequest(url As String) As String
Dim oXHTTP As Object
   
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    oXHTTP.Open "GET", url, False
    oXHTTP.send
    ExecuteWebRequest = oXHTTP.responseText
    Set oXHTTP = Nothing

End Function

Public Function FindString(ByVal InputString As String, ByVal RegexPattern As String, _
        ByVal ReturnArrayElement As Long) As String

        On Error GoTo Err:

        Dim regex As Object, regexsplit As Object
        Set regex = CreateObject("vbscript.regexp")
        regex.Ignorecase = True
        regex.MultiLine = True
        regex.Global = True
        regex.Pattern = RegexPattern
        Set regexsplit = regex.Execute(InputString)
        FindString = regexsplit(ReturnArrayElement)

ExitFunction:

        On Error GoTo 0
        Exit Function
       
Err:
        FindString = vbNullString
        Resume ExitFunction
        Resume 'for debugging

End Function

[Ian1506]

Thanks for the replies folks. Ozknows. I'll give yours a try tonight.

[KevinTHFC]

Not sure why but the following code would not work for me

Code: Select all

With Sheet1 '**Change to whatever sheet you need**
                    .Range("A" & writerow).Value = FindString(singlemeeting.innerText, "[0-9]*:[0-9][0-9]", 0)
                    .Range("B" & writerow).Value = course
                    .Range("C" & writerow).Value = singlemeeting.innerText
                    .Range("D" & writerow).Value = FindString(singlemeeting.innerText, "Cl[1-7]", 0)
                End With

But changing to this did????

Code: Select all

Range("A" & writerow).Value = FindString(singlemeeting.innerText, "[0-9]*:[0-9][0-9]", 0)
                    Range("B" & writerow).Value = course
                    Range("C" & writerow).Value = singlemeeting.innerText
                    Range("D" & writerow).Value = FindString(singlemeeting.innerText, "Cl[1-7]", 0)

[osknows]

It probably means your workbook doesn't have a Sheet1 codename. You're amended code will write to the current active sheet so if you change sheets whilst the code is running it will write across several sheets.

A new Excel workbook normally defaults to 3 fresh sheets named
Sheet1
Sheet2
Sheet3

If I change the name of each tab in Excel to say
Tab 1
Tab 2
Tab 3

If you then look in the VB editor you will see
Sheet1 (Tab 1)
Sheet2 (Tab 2)
Sheet3 (Tab 3)

The name of the first sheet is "Tab 1", the codename of the first sheet is "Sheet1"

Codenames are useful as it means a user can change the name of the sheets without impacting code, hence why I used

Code: Select all

With Sheet1
  .Range("A" & writerow).Value =......
 .....
end with

[KevinTHFC]

Hi osknows,

Agree with all you say. I did have a Sheet1, if not the code would have thrown an exception.

The code ran fine but nothing was written to Sheet1, so I simply removed the With Sheet1 reference and all was fine.

[Ian1506]

Hi Osknows, Unfortunately I am have some trouble with this code. I have saved the code to a module, checked the HTML objectlibrary in references and have a sheet named sheet 1. The code does not seem to be running. Am I missing something?
Cheers Ian

[osknows]

Does it work for you using this Excel file? http://www.mediafire.com/?t8cf8ztc8iz5hti

[KevinTHFC]

I know your question was to Ian but it works for me.

I wonder if Ian is having the same problem as I was?

[Ian1506]

Hi Osknows and Kevin.
I had much more luck with the 2nd file thru mediafire and it is working just fine. Thanks so much for your help

[Ian1506]

Hi osknows. Sorry to be a pain in the ...

The down load works just fine but I seem to be having some difficulty with the time in the first column.

As you can see, the first at Kempton is due to go off at 1340 hours but the first column shows it to be going off at 0140 hours. Unfortunately I am using the value in column 1 in a lookup to return the class.
I've tried various formats but have had no luck. Is there anything I can change within the module to make these times correct?
Cheers Ian

1:40:00 AM KEMPTON (AW) 1:40 Download The Blue Square Bet App Median Auction Maiden Stakes Cl6 5f Card Betting Cl6
2:10:00 AM KEMPTON (AW) 2:10 Win Thousands of Sports Experiences At bluesq.com Nursery Cl6 5f Card Betting Cl6
2:45:00 AM KEMPTON (AW) 2:45 Bet And Watch At bluesq.com Handicap Cl5 1m2f Card Betting Cl5
3:15:00 AM KEMPTON (AW) 3:15 Bet At bluesq.com On Your Mobile Handicap (Div I) Cl4 5f Card Betting Cl4
3:45:00 AM KEMPTON (AW) 3:45 Bet At bluesq.com On Your Mobile Handicap (Div II) Cl4 5f Card Betting Cl4
4:15:00 AM KEMPTON (AW) 4:15 Play Roulette At bluesq.com/casino Selling Stakes Cl6 6f Card Betting Cl6
4:45:00 AM KEMPTON (AW) 4:45 Blue Square Median Auction Maiden Stakes Cl6 1m Card Betting Cl6
5:15:00 AM KEMPTON (AW) 5:15 Play Rainbow Riches On Your iPhone Handicap Cl6 1m3f Card Betting Cl6
12:20:00 PM MUSSELBURGH 12:20 Buy Your 2012 Annual Members Badge Today Amateur Riders´ Handicap Chase Cl5 2m4f Card Betting Cl5
12:50:00 PM MUSSELBURGH 12:50 Racing UK Showing The Best Racecourses Live Maiden Hurdle Cl5 2m Card Betting Cl5
1:20:00 AM MUSSELBURGH 1:20 Scottish Racing Beginners´ Chase Cl5 2m4f Card Betting Cl5
1:50:00 AM MUSSELBURGH 1:50 Arnolds Handicap Hurdle Cl5 2m4f Card Betting Cl5
2:20:00 AM MUSSELBURGH 2:20 TurfTV Handicap Hurdle Cl3 2m Card Betting Cl3
2:55:00 AM MUSSELBURGH 2:55 Racing UK Handicap Chase Cl4 2m Card Betting Cl4
3:25:00 AM MUSSELBURGH 3:25 Wishing You A Happy Christmas Standard Open National Hunt Flat Race Cl6 2m Card Betting Cl6