scrape sportinglife using Excel VBA

[youngstar]

I'm trying to scrape race card info from Sporting life.
Currently, I'm able to get hold of the links for each race and extract the time & track using Excel VBA.

I want to be able to extract each runner's name and specifically the "BF" info for each runner (whether it
was a beaten favourite).

Anyone doing this at the moment?


Thanks
Young

[alrodopial]

It's element has class name "rp-cdwf"

[youngstar]

Al

Do you have the code to extract the runner's name and whether BF.
I can't find "rp-cdwf" in the source code when I open a race card in Sportinglife


Thanks

[alrodopial]

Give me a couple of days
It's class name is "sui enable-tooltip sui-bf"

[youngstar]

ok, thanks in advance.

[MiniBlueDragon]

Would something like this work? (not checked it)

Code: Select all

Set iDocElements = iDoc.getElementsByClassName("horse-dtl")

   For Each iElement In iDocElements
                  
      ' Get Runner Name
      runnerName = iElement.Children(1).innerText
      runnerName = Replace(Replace(Replace(Trim(runnerName), " ", " |"), "| ", ""), " |", " ")
      
      ' Strip Country info            
      j = InStr(runnerName, "(")
      If j > 0 Then runnerName = Trim(Left(runnerName, j - 1))
      
      Set bfElements = iElement.getElementsByClassName("sui enable-tooltip sui-bf")
      
      If bfElements.length > 0 Then
         beatenFav = 1
      End If
      
      myRow = myRow + 1
      
   Next

[alrodopial]

Would something like this work? (not checked it)

Code: Select all

Set iDocElements = iDoc.getElementsByClassName("horse-dtl")

   For Each iElement In iDocElements
                  
      ' Get Runner Name
      runnerName = iElement.Children(1).innerText
      runnerName = Replace(Replace(Replace(Trim(runnerName), " ", " |"), "| ", ""), " |", " ")
      
      ' Strip Country info            
      j = InStr(runnerName, "(")
      If j > 0 Then runnerName = Trim(Left(runnerName, j - 1))
      
      Set bfElements = iElement.getElementsByClassName("sui enable-tooltip sui-bf")
      
      If bfElements.length > 0 Then
         beatenFav = 1
      End If
      
      myRow = myRow + 1
      
   Next

It looks ok to me

[youngstar]

I'm getting "run-time error '424': Object required" on the first line!

Set iDocElements = iDoc.getElementsByClassName("horse-dtl")

[alrodopial]

copy paste the below in a module and run the macro
Adjust the "goURL"

Code: Select all

Dim goURL As String
Dim IE1 As Object
Dim IEdoc1 As MSHTML.HTMLDocument

Sub openURL_IE1()
   
    If IE1 Is Nothing Then
        Set IE1 = CreateObject("InternetExplorer.Application")
        IE1.Visible = True
    End If
    Application.StatusBar = "Loading page ... " & goURL
    IE1.Navigate goURL
    Do While IE1.Busy Or IE1.ReadyState <> 4: DoEvents: Loop
    Application.StatusBar = False
   
    Set IEdoc1 = IE1.document
   
End Sub

Sub getBFfromSLcard()
   
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
   
    goURL = "http://www.sportinglife.com/racing/meeting/haydock-park/09-06-2016/fast-cards"
   
    Call openURL_IE1
   
    Set races = IEdoc1.getElementsByClassName("rac-dgp") ' all races info
    If races.Length > 0 Then
        copyRow = 1
        For i = 0 To races.Length - 1
            raceDescription = Trim(races(i).getElementsByClassName("hdr t2")(0).innerText)
            Set horseInfo = races(i).getElementsByClassName("ixt")
            If horseInfo.Length > 0 Then
                For ii = 0 To horseInfo.Length - 1
                    If InStr(horseInfo(ii).innerHTML, "racing/profiles/horse") > 0 Then
                        horseName = Trim(horseInfo(ii).getElementsByTagName("a")(0).innerText)
                        horseBF = ""
                        Set tempObject = horseInfo(ii).getElementsByClassName("sui enable-tooltip sui-bf")
                        If tempObject.Length > 0 Then
                            horseBF = "BF"
                        End If
                       
                        MyArray = Array(raceDescription, horseName, horseBF)
                        ws1.Range("A" & copyRow & ":C" & copyRow) = MyArray
                        copyRow = copyRow + 1
                    End If
                Next ii
            End If
        Next i
    End If
   
End Sub

I also tried the "horseInfo(ii).href" but isn't working

[youngstar]

Great! That worked.

Thanks for the help, Al.

One thing I didn't mention when I said that I am able to get hold of the links for each race.
It's not using the fast cards. I get the links for each race like the 2 examples below, which means I can't plug these into your code.

http://www.sportinglife.com/racing/race ... icap-div-1
http://www.sportinglife.com/racing/race ... d-handicap

Do you have any codes that can get the links for each fastcard meeting, just like your previous code:-
"http://www.sportinglife.com/racing/meeting/haydock-park/09-06-2016/fast-cards"

I can then use your runners code to read in each meeting and display the runners and "BF".


Thanks

[alrodopial]

Code: Select all

Sub getFastCardLinks()
   
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    goURL = "http://www.sportinglife.com/racing/racecards"
   
    Call openURL_IE1
   
    Set fastCardLinks = IEdoc1.getElementsByClassName("sui-fastcards")
    If fastCardLinks.Length > 0 Then
        copyRow = 1
        For i = 0 To fastCardLinks.Length - 1
            ws1.Range("A" & copyRow) = fastCardLinks(i).href
            copyRow = copyRow + 1
        Next i
    End If
   
End Sub

[youngstar]

Al,
Excellent! Got it working.

Thanks for your help,