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
Any ideas why this is, sheet is called "Races".
[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".