fredrerik84
Active Member
- Joined
- Feb 26, 2017
- Messages
- 383
I have my script which has worked without any problem for about 1 year. Until today as far as I can tell no changes have been made to target website.
I scarpe like this.
1 download html doc as a text file
then I run this code:
2 , then I run this code , which extract the data from the text file:
Does anyone know what might be wrong ?
Frederik
I scarpe like this.
1 download html doc as a text file
then I run this code:
2 , then I run this code , which extract the data from the text file:
Code:
Sub XscoreSoccer()
Dim ws As Worksheet: Set ws = Worksheets("Data")
Dim LrowData, LrowTeams, LrowLeague, lr, lrdata, datalr As Long, j As Long, posfrom As Long, _
posFrom2, Startpos As Long, EndPos As Long, posto As Long, posTo2 As Long, Country As String, _
League As String, textline As String, NewLeague As String, Hteam As String, LP As String, _
boldremover As String, HomeFT As String, AwayFT As String, FT As String, Ateam As String, _
FindTeamB As String, venue As String, mTime As String, CountryAbbreviation As String, _
FindTeamA As String, Pos As String, Friendly As String, HomeHT As String, AwayHT As String, _
mDate As Date, Season As String, txt As String, PN As String, HomeET As String, AwayET As String, _
YcardHome As String, YcardAway As String, RcardHome As String, RcardAway As String, Round As String, _
TimeZone As String, gameStatus As String, MyFile As String, Sport As String, competition As String
Sport = LetterCase(ws.Cells(14, "AW"))
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
TimeZone = ws.Cells(3, "AW")
TimeZone = Application.VLookup(TimeZone, ws.Range("AZ2:BA5"), 2, False)
MyFile = ThisWorkbook.Path & "\HtmlDoc.txt"
LrowData = ws.Cells(Rows.Count, "H").End(xlUp).row
LrowTeams = ws.Cells(Rows.Count, "AH").End(xlUp).row
LrowLeague = ws.Cells(Rows.Count, "AR").End(xlUp).row
lr = Cells(Rows.Count, 2).End(xlUp).row + 1
lrdata = ws.Cells(Rows.Count, "AQ").End(xlUp).row
datalr = ws.Cells(Rows.Count, "AG").End(xlUp).row
MyFile = ThisWorkbook.Path & "\HtmlDoc.txt"
Open MyFile For Input As #1
j = 12
Line Input #1, textline
Do
posfrom = InStr(textline, "data-league-name=""")
If posfrom <> 0 Then
'League
posto = InStr(posfrom + 19, textline, """")
League = Mid$(textline, posfrom + 19, posto - 19 - posfrom)
League = LetterCase(League)
League = LeagueLookup(League)
'Matchdate
posfrom = InStr(textline, "data-matchday=""")
posto = InStr(posfrom + 16, textline, """")
mDate = Mid$(textline, posfrom + 16, posto - 16 - posfrom)
mDate = Replace(mDate, "-", "/")
Cells(j, "X").Value = mDate
'Home Team
posfrom = InStr(textline, "data-home-team=""")
posto = InStr(posfrom + 19, textline, """")
Hteam = Mid$(textline, posfrom + 17, posto - 17 - posfrom)
Hteam = LetterCase(Hteam)
Hteam = soccer(Hteam)
On Error Resume Next
Hteam = Application.VLookup(Hteam, ws.Range("AG" & 2 & ":AH" & LrowTeams), 2, False)
Sheets("Soccer").Cells(j, "I").Value = Hteam
Code:
'Away Team
posfrom = InStr(textline, "data-away-team=""")
posto = InStr(posfrom + 17, textline, """")
Ateam = Mid$(textline, posfrom + 17, posto - 17 - posfrom)
Ateam = LetterCase(Ateam)
Ateam = soccer(Ateam)
Ateam = Application.VLookup(Ateam, ws.Range("AG" & 2 & ":AH" & LrowTeams), 2, False)
Sheets("Soccer").Cells(j, "M").Value = Ateam
'GameStatus
posfrom = InStr(textline, "data-game-status=""")
posto = InStr(posfrom + 20, textline, """")
gameStatus = Mid$(textline, posfrom + 19, posto - 19 - posfrom)
gameStatus = Replace(gameStatus, "Sched", "SCH")
gameStatus = Replace(gameStatus, "2 HF", "2HF")
gameStatus = Replace(gameStatus, "Post", "PSTP")
gameStatus = Replace(gameStatus, "1 HF", "1HF")
gameStatus = Replace(gameStatus, "H/T", "HT")
gameStatus = Replace(gameStatus, "Fin", "FT")
gameStatus = Replace(gameStatus, "SCH", "KO")
Sheets("Soccer").Cells(j, "E").Value = gameStatus
Sheets("Soccer").Cells(j, "K").Value = "-:-"
'Country
posfrom = InStr(textline, "data-country-name=""")
posto = InStr(posfrom + 20, textline, """")
Country = Mid$(textline, posfrom + 20, posto - 20 - posfrom)
Country = LetterCase(Country)
Country = ReplaceCountry(Country)
Sheets("Soccer").Cells(j, "F").Value = Country
'New String
posfrom = InStr(textline, "data-country-name=""")
posto = InStr(posfrom + 3020, textline, """")
txt = Mid$(textline, posfrom + 0, posto - 20 - posfrom)
'HomeFT
posFrom2 = InStr(txt, "score_score score_cell centerTXT")
posTo2 = InStr(posFrom2 + 100, txt, """")
HomeFT = Mid$(txt, posFrom2 + 82, posTo2 - 91 - posFrom2)
HomeFT = Left(HomeFT, 10)
HomeFT = Left(HomeFT, 1)
'AwayFT
posFrom2 = InStr(txt, "scorea_ft score_cell centerTXT")
posTo2 = InStr(posFrom2 + 41, txt, "")
AwayFT = Mid$(txt, posFrom2 + 33, posTo2 - 40 - posFrom2)
'Output to sheet
Select Case gameStatus
Case "PSTP"
Sheets("Soccer").Cells(j, "K").Value = "PSTP"
Case "Canc"
Sheets("Soccer").Cells(j, "K").Value = "Canc"
Case Else
Sheets("Soccer").Cells(j, "K").Value = HomeFT & " - " & AwayFT
End Select
'HomeFT
posFrom2 = InStr(txt, "scoreh_ht score_cell centerTXT")
posTo2 = InStr(posFrom2 + 50, txt, "")
HomeHT = Mid$(txt, posFrom2 + 33, posTo2 - 87 - posFrom2)
'AwayHT
posFrom2 = InStr(txt, "scorea_ht score_cell centerTXT")
posTo2 = InStr(posFrom2 + 36, txt, "")
AwayHT = Mid$(txt, posFrom2 + 33, posTo2 - 40 - posFrom2)
Sheets("Soccer").Cells(j, "O").Value = HomeHT & " - " & AwayHT
'Round
posfrom = InStr(textline, "data-league-round=""")
posto = InStr(posfrom + 20, textline, """")
Round = Mid$(textline, posfrom + 20, posto - 20 - posfrom)
Round = LetterCase(Round)
Round = Replace(Round, "Gs", "GS")
Round = Replace(Round, "Sf", "SF")
Sheets("Soccer").Cells(j, "W").Value = Round
'leaguePos (Home)
posFrom2 = InStr(txt, "")
posTo2 = InStr(posFrom2 + 70, txt, """")
Sheets("Soccer").Cells(j, "J").Value = Mid$(txt, posFrom2 + 16, posTo2 - 70 - posFrom2)
'leaguePos (Away)
posFrom2 = InStr(txt, "score_away_txt score_cell wrap")
posTo2 = InStr(posFrom2 + 122, txt, """")
LP = Mid$(txt, posFrom2 + 90, posTo2 - posFrom2 - 0)
LP = Replace(LP, "
", "")
LP = Replace(LP, "", "")
Startpos = InStr(LP, "'lp'")
LP = Mid(LP, Startpos + 5, 2)
If Right(LP, 1) = vbLf Then LP = Left(LP, 1)
LP = Replace(LP, "&n", "")
Sheets("Soccer").Cells(j, "L").Value = LP
'PN
posFrom2 = InStr(txt, "score_pen score_cell")
posTo2 = InStr(posFrom2 + 23, txt, "")
PN = Mid$(txt, posFrom2 + 23, posTo2 - 23 - posFrom2)
PN = Replace(PN, "-", " - ")
Sheets("Soccer").Cells(j, "Q").Value = PN
'Home ET
posFrom2 = InStr(txt, "scoreh_et score_cell centerTXT")
posTo2 = InStr(posFrom2 + 0, txt, "")
HomeET = Mid$(txt, posFrom2 + 0, posTo2 - 0 - posFrom2)
HomeET = Replace(HomeET, "scoreh_et score_cell centerTXT", "")
HomeET = Replace(HomeET, """>", "")
HomeET = Replace(HomeET, """", "")
'Cells(j, "AA").Value = HomeET
'Away ET
posFrom2 = InStr(txt, "scorea_et score_cell centerTXT")
posTo2 = InStr(posFrom2 + 0, txt, "")
AwayET = Mid$(txt, posFrom2 + 0, posTo2 - 0 - posFrom2)
AwayET = Replace(AwayET, "scorea_et score_cell centerTXT", "")
AwayET = Replace(AwayET, """>", "")
AwayET = Replace(AwayET, """", "")
If HomeET <> "" Then Sheets("Soccer").Cells(j, "P").Value = HomeET & " - " & AwayET
'YellowCards (Home)
posFrom2 = InStr(txt, "score_home_txt score_cell wrap")
posTo2 = InStr(posFrom2 + 270, txt, """")
YcardHome = Mid$(txt, posFrom2 + 0, posTo2 - 0 - posFrom2)
posFrom2 = InStr(YcardHome, "y_cards")
posTo2 = InStr(posFrom2 + 20, YcardHome, "")
YcardHome = Mid$(YcardHome, posFrom2 + 0, posTo2 - 0 - posFrom2)
If InStr(YcardHome, " ") <> 0 Then YcardHome = ""
YcardHome = Right(YcardHome, 8)
YcardHome = Replace(YcardHome, "", "")
Sheets("Soccer").Cells(j, "S").Value = Right(YcardHome, 8)
'YellowCards (Away)
posFrom2 = InStr(txt, "score_away_txt score_cell wrap")
posTo2 = InStr(posFrom2 + 270, txt, """")
YcardAway = Mid$(txt, posFrom2 + 0, posTo2 - 0 - posFrom2)
posFrom2 = InStr(YcardAway, "y_cards")
posTo2 = InStr(posFrom2 + 20, YcardAway, "")
YcardAway = Mid$(YcardAway, posFrom2 + 0, posTo2 - 0 - posFrom2)
If InStr(YcardAway, " ") <> 0 Then YcardAway = ""
YcardAway = Right(YcardAway, 8)
YcardAway = Replace(YcardAway, "", "")
Sheets("Soccer").Cells(j, "T").Value = Right(YcardAway, 8)
'RedCards (Home)
posFrom2 = InStr(txt, "score_home_txt score_cell wrap")
posTo2 = InStr(posFrom2 + 370, txt, """")
RcardHome = Mid$(txt, posFrom2 + 0, posTo2 - 0 - posFrom2)
posFrom2 = InStr(RcardHome, "r_cards")
posTo2 = InStr(posFrom2 + 0, RcardHome, "/div")
RcardHome = Mid$(RcardHome, posFrom2 + 0, posTo2 - 0 - posFrom2)
If InStr(RcardHome, " ") <> 0 Then RcardHome = ""
RcardHome = Right(RcardHome, 9)
RcardHome = Left(RcardHome, 1)
Sheets("Soccer").Cells(j, "U").Value = RcardHome
'RedCards (away)
posFrom2 = InStr(txt, "score_away_txt score_cell wrap")
posTo2 = InStr(posFrom2 + 370, txt, """")
RcardAway = Mid$(txt, posFrom2 + 0, posTo2 - 0 - posFrom2)
posFrom2 = InStr(RcardAway, "r_cards")
posTo2 = InStr(posFrom2 + 0, RcardAway, "/div")
RcardAway = Mid$(RcardAway, posFrom2 + 0, posTo2 - 0 - posFrom2)
If InStr(RcardAway, " ") <> 0 Then RcardAway = ""
RcardAway = Right(RcardAway, 9)
RcardAway = Left(RcardAway, 1)
Sheets("Soccer").Cells(j, "V").Value = RcardAway
'Season
posfrom = InStr(textline, "data-season=""")
posto = InStr(posfrom + 14, textline, """")
Season = Mid$(textline, posfrom + 14, posto - 14 - posfrom)
Sheets("Soccer").Cells(j, "R").Value = Season
'League Prefix
CountryAbbreviation = LCase(Application.VLookup(Country, ws.Range("H" & 2 & ":I" & LrowData), 2, False))
League = League & " (" & CountryAbbreviation & ")"
League = Application.VLookup(League, ws.Range("AQ" & 2 & ":AR" & LrowLeague), 2, False)
Sheets("Soccer").Cells(j, "H").Value = League
'MatchTime
posfrom = InStr(textline, "score_ko score_cell""")
posto = InStr(posfrom + 22, textline, """")
mTime = Mid$(textline, posfrom + 22, posto - 41 - posfrom)
mTime = DateAdd("h", TimeZone, mTime)
'Cells(j, "E").Value = TimeValue(mTime)
Sheets("Soccer").Cells(j, "D").Value = mDate + TimeValue(mTime)
'Venue
posfrom = InStr(textline, "data-note=""")
venue = Mid$(textline, posfrom + 19, posto - 19 - posfrom)
EndPos = InStr(1, venue, "Turf:")
venue = Left(venue, EndPos - 3)
If Len(venue) = 3 And venue = "ut." Then venue = "Unknown Venue"
If InStr(venue, "competition-name") Then venue = "Unknown Venue"
If InStr(venue, "Venue:") Then
Startpos = InStr(venue, "Venue:")
venue = Mid(venue, Startpos + 6)
End If
venue = Replace(venue, "f second half delayed. Venue: ", "")
If Left(venue, 1) = vbLf Then venue = Mid(venue, 2)
Sheets("Soccer").Cells(j, "N").Value = venue
'Reset Vars
CountryAbbreviation = ""
League = ""
Country = ""
Hteam = ""
Ateam = ""
venue = ""
HomeHT = ""
AwayET = ""
HomeET = ""
j = j + 1
textline = Mid$(textline, posfrom + posto - posfrom + 1)
End If
Loop While InStr(textline, "data-country-name") <> 0
Close #1
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
'If ws.Cells(2, "AW") = "Upcoming" Then RemovePassedDate
If ActiveSheet.Name <> "Mockup" Then
ActiveLinkBtn
Cells(12, "B").Select
End If
Sheets("Soccer").Cells(11, "B").Value = mDate
End SubDoes anyone know what might be wrong ?
Frederik
Last edited:
