JSON not pulling data from web

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
840
I have the following links in G2:G10

[TABLE="width: 463"]
<colgroup><col></colgroup><tbody>[TR]
[TD]https://greyhoundbet.racingpost.com/#card/race_id=1694843&r_date=2019-05-13&tab=form[/TD]
[/TR]
[TR]
[TD]https://greyhoundbet.racingpost.com/#card/race_id=1694997&r_date=2019-05-13&tab=form[/TD]
[/TR]
[TR]
[TD]https://greyhoundbet.racingpost.com/#card/race_id=1695035&r_date=2019-05-13&tab=form[/TD]
[/TR]
[TR]
[TD]https://greyhoundbet.racingpost.com/#card/race_id=1695147&r_date=2019-05-13&tab=form[/TD]
[/TR]
[TR]
[TD]https://greyhoundbet.racingpost.com/#card/race_id=1694844&r_date=2019-05-13&tab=form[/TD]
[/TR]
[TR]
[TD]https://greyhoundbet.racingpost.com/#card/race_id=1694998&r_date=2019-05-13&tab=form[/TD]
[/TR]
[TR]
[TD]https://greyhoundbet.racingpost.com/#card/race_id=1695036&r_date=2019-05-13&tab=form[/TD]
[/TR]
[TR]
[TD]https://greyhoundbet.racingpost.com/#card/race_id=1695148&r_date=2019-05-13&tab=form[/TD]
[/TR]
[TR]
[TD]https://greyhoundbet.racingpost.com/#card/race_id=1694845&r_date=2019-05-13&tab=form[/TD]
[/TR]
</tbody>[/TABLE]


Then the following code fails on line .send

Code:
Option Explicit

Private Enum URLPart


    race_id = 0
    date_id = 1
    
End Enum


Public Sub Greyhound_Urls()


    Dim LastRow     As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim dogLinks    As Variant


    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    
    LastRow = Sheets("Races").Range("G" & Rows.Count).End(xlUp).row
    urls = Sheets("Races").Range("G2:G" & LastRow).Value
    
    For x = LBound(urls) To UBound(urls)
        dogLinks = getDogLinksFromUrl(urls(x, 1))
        Sheets("Races").Cells(Sheets("Races").Rows.Count, 8).End(xlUp).Offset(1).Resize(UBound(dogLinks), 1).Value2 = dogLinks
        
    DoEvents
    
    Next x
    
    Sheets("Races").Range("I2").FormulaR1C1 = "=""http://greyhoundbet.racingpost.com/dog/blocks.sd?race_id=""&MID(RC[-1],49,7)&""&r_date=""&MID(RC[-1],64,10)&""&dog_id=""&RIGHT(RC[-1],6)&""&blocks=details"""
    Sheets("Races").Range("I2").AutoFill Destination:=Range("I2:I" & Sheets("Races").Range("H" & Rows.Count).End(xlUp).row)
    Sheets("Races").Range("I2").FormulaR1C1 = "=""http://greyhoundbet.racingpost.com/dog/blocks.sd?race_id=""&MID(RC[-1],49,7)&""&r_date=""&MID(RC[-1],64,10)&""&dog_id=""&RIGHT(RC[-1],6)&""&blocks=details"""
    Sheets("Races").Range("I2").AutoFill Destination:=Range("I2:I" & Sheets("Races").Range("H" & Rows.Count).End(xlUp).row)
    Sheets("Races").Range("J2").FormulaR1C1 = "=MID(RC[-3],50,7)"
    Sheets("Races").Range("J2").AutoFill Destination:=Range("J2:J" & Sheets("Races").Range("H" & Rows.Count).End(xlUp).row)
    Sheets("Races").Range("K2").FormulaR1C1 = "=MID(RC[-2],58,7)"
    Sheets("Races").Range("K2").AutoFill Destination:=Range("K2:K" & Sheets("Races").Range("H" & Rows.Count).End(xlUp).row)
    Sheets("Races").Range("L2").FormulaR1C1 = "=MID(RC[-3],91,6)"
    Sheets("Races").Range("L2").AutoFill Destination:=Range("L2:L" & Sheets("Races").Range("H" & Rows.Count).End(xlUp).row)
    Sheets("Races").Range("H:I").Columns.AutoFit
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    
End Sub


Private Function getDogLinksFromUrl(ByVal url As String) As Variant


    Dim json   As String
    Dim spl()  As String
    Dim ret() As String
    Dim x      As Long
    
    Dim urlParts() As String
     
    Dim raceId As String
    Dim dateId As String
    
    urlParts = getRaceIdAndDateFromUrl(url)
    
    raceId = urlParts(URLPart.race_id)
    dateId = urlParts(URLPart.date_id)
    
    
    With CreateObject("msxml2.xmlhttp")
       .Open "GET", "http://greyhoundbet.racingpost.com/card/blocks.sd?race_id=" & raceId & "&r_date=" & dateId & "&tab=form&blocks=form", False
       .send
       json = .responseText
    End With
     
    spl = Split(json, "dogId"":""")
     
    If UBound(spl) > 1 Then
       ReDim ret(1 To UBound(spl), 1 To 1)
       For x = 1 To UBound(spl)
           ret(x, 1) = formatLink(Val(spl(x)), raceId, dateId)
       Next x
    End If
     
    getDogLinksFromUrl = ret
 
End Function


Private Function formatLink(ByVal dogId As Long, ByVal raceId As String, ByVal dateId As String) As String


    formatLink = "http://greyhoundbet.racingpost.com/#dog/race_id=" & raceId & "&r_date=" & dateId & "&dog_id=" & dogId
    
End Function


Private Function getRaceIdAndDateFromUrl(ByVal url As String) As String()
    
    Dim ret(0 To 1) As String
    
    ret(0) = Split(Split(url, "race_id=")(1), "&")(0)
    ret(1) = Split(Split(url, "r_date=")(1), "&")(0)
    
    getRaceIdAndDateFromUrl = ret
    
End Function

Any ideas why this is, sheet is called "Races".
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Change the http GET to https, and the json = line to:
Code:
        json = StrConv(.responseBody, vbUnicode)
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top