JSON not pulling data from web

[jamescooper]

I have the following links in G2:G10

https://greyhoundbet.racingpost.com/#card/race_id=1694843&r_date=2019-05-13&tab=form

https://greyhoundbet.racingpost.com/#card/race_id=1694997&r_date=2019-05-13&tab=form

https://greyhoundbet.racingpost.com/#card/race_id=1695035&r_date=2019-05-13&tab=form

https://greyhoundbet.racingpost.com/#card/race_id=1695147&r_date=2019-05-13&tab=form

https://greyhoundbet.racingpost.com/#card/race_id=1694844&r_date=2019-05-13&tab=form

https://greyhoundbet.racingpost.com/#card/race_id=1694998&r_date=2019-05-13&tab=form

https://greyhoundbet.racingpost.com/#card/race_id=1695036&r_date=2019-05-13&tab=form

https://greyhoundbet.racingpost.com/#card/race_id=1695148&r_date=2019-05-13&tab=form

https://greyhoundbet.racingpost.com/#card/race_id=1694845&r_date=2019-05-13&tab=form

<colgroup><col></colgroup><tbody>
</tbody>

Then the following code fails on line .send

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".

 

[jamescooper]

Any idea here please?

 

[John_w]

Change the http GET to https, and the json = line to:

        json = StrConv(.responseBody, vbUnicode)

 

[jamescooper]

John_w thank you works great!