1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
| Sub odds(match_id)
ThisWorkbook.Sheets("ODDS").Range("A2:C3000").ClearContents
TableRow = 2
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://d.flashscore.com/x/feed/d_od_" & match_id & "_en_1_eu", False
http.setRequestHeader "X-Fsign", "SW9D1eZo"
http.Send: DoEvents
fs_input = http.ResponseText
fs_input = Replace(fs_input, Chr(9), "")
fs_input = Replace(fs_input, Chr(10), "")
fs_input = Replace(fs_input, Chr(13), "")
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True
objRegExp.MultiLine = True
objRegExp.Pattern = "block-ht-ft-ft(.*?)block-correct-score-ft"
If objRegExp.test(fs_input) = True Then
Set objMatches = objRegExp.Execute(fs_input)
fs_input = objMatches.Item(0).submatches(0)
objRegExp.Pattern = "<tr(.*?)<td(.*?)title=" & Chr(34) & "(.*?)" & Chr(34) & "(.*?)htft(.*?)>(.*?)<(.*?)odds-wrap(.*?)>(.*?)<(.*?)tr>"
If objRegExp.test(fs_input) = True Then
Set objMatches = objRegExp.Execute(fs_input)
For Each m In objMatches
ThisWorkbook.Sheets("ODDS").Range("A" & TableRow).Value = m.submatches(2)
ThisWorkbook.Sheets("ODDS").Range("B" & TableRow).Value = m.submatches(5)
ThisWorkbook.Sheets("ODDS").Range("C" & TableRow).Value = m.submatches(8)
TableRow = TableRow + 1
Next
End If
End If
End Sub |
Partager