Einlesen: Text.Datei oder Html

Sub datenabruf()
Dim objXMLHTTP As Object, html As Object, html1 As Object
Dim link As Object, div As Object
Dim iRow As Long, start As Single, slink As String
Dim larClubs(), liIdx As Integer, liIdxC As Integer, lboReady As Boolean
Dim lshList As Worksheet, loRowList As Long, lboHit As Boolean, lboHit1 As Boolean
ReDim larClubs(7, 0)
Set lshList = Sheets("Liste") 'wenn Liste im Original anders heißt, dann hier anpassen
Application.ScreenUpdating = False
'du entfernst mit .ClearContent nur die Einträge - ich lösche mit .Delete immer die ganzen Zeilen: löschen = besser als nur entfernen, weil
'...ein Durchlauf findet für 100 Zeilen die Einträge
'...wenn beim nächsten Durchlauf (es werden nur 20 gefunden) die zuvor genutzen 100 Zeilen nur entfernt, nicht gelöscht werden, dann speichert Excel alles weiterhin mit 100 genutten Zeilen
'...daher, immer besser, Zeilen wirklich zu löschen und nicht nur Einträge entfernen
LZ_1 = Sheets("Live").Cells(Rows.Count, 1).End(xlUp).Row
If LZ_1 >= 5 Then
Sheets("Live").Rows("5:" & LZ_1).Delete
End If
' Sheets("Live").Range("A5:M" & LZ_1).ClearContents
' Sheets("Live").Range("O5:BX" & LZ_1).ClearContents
iRow = 4
start = Timer
Set html = CreateObject("htmlfile")
Set html1 = CreateObject("htmlfile")
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.Open "GET", "https://www.totalcorner.com/match/today/", False
objXMLHTTP.send
If objXMLHTTP.Status = 200 Then
html.body.innerHTML = objXMLHTTP.responseText
With ActiveSheet
'du willst erreichen, dass in "LIVE" nur die Spiele gelistet werden, deren Liga in "LISTE" eingetragen sind
'mit deinem alten Code fängst du mit deinem alten Code aber beim 1. Treffer schon an, in Spalte A den Hyperlink einzutragen - obwohl du noch gar nicht weißt, ob das gefundene Spiel zu deinen Ligen aus "LISTE" passt
'daher muss man pro Spiel die gefundenen Einträge erst mal sammeln - ich sammel die Einträge jedes Spiels in der Arrayvariablen larClubs
For Each link In html.getElementsByTagName("a")
If InStr(1, link.href, "/match/corner-stats")  0 Then
larClubs(0, 0) = link.nameProp 'in larClubs(0,0) merkt sich mein Code den Text, der im Hyperlink erscheint
objXMLHTTP.Open "GET", Replace(link.href, "about:", "https://www.totalcorner.com"), False
objXMLHTTP.send
If objXMLHTTP.Status = 200 Then
html1.body.innerHTML = objXMLHTTP.responseText
For Each div In html1.getElementsByTagName("div")
If div.classname = "col-xs-12 col-sm-6 no-left-padding moble_no_right_padding" Then
larClubs(1, 0) = div.innerText 'in larClubs(1, 0) merkt sich mein Code den Eintrag für Spalte D
End If
If div.classname = "col-xs-12 col-sm-6 no-right-padding moble_no_left_padding" Then
larClubs(2, 0) = div.innerText 'in larClubs(2, 0) merkt sich mein Code den Eintrag für Spalte E
End If
If div.classname = "match-facts-pred" Then
larClubs(3, 0) = div.innerText 'in larClubs(3, 0) merkt sich mein Code den Eintrag für Spalte F
End If
If div.classname = "match-facts-history" Then
larClubs(4, 0) = div.innerText 'in larClubs(4, 0) merkt sich mein Code den Eintrag für Spalte G
End If
If div.classname = "panel-body" Then      ' 1Hz schüsse, angriffe
larClubs(5, 0) = div.innerText 'in larClubs(5, 0) merkt sich mein Code den Eintrag für Spalte H
End If
If div.classname = "panel panel-default" Then     ' Gesamt schüsse, angriffe
larClubs(6, 0) = div.innerText 'in larClubs(6, 0) merkt sich mein Code den Eintrag für Spalte I
End If
If div.classname = "main_content" Then     ' Land Liga
larClubs(7, 0) = div.innerText 'in larClubs(7, 0) merkt sich mein Code den Eintrag für Spalte J ACHTUNG! hier steht die LIGA drin, die in LISTE enthalten sein muss
End If
For liIdx = 0 To UBound(larClubs, 2)
'wenn ein Eintrag in Spalte J vorhanden,...
If larClubs(7, liIdx)  "" Then
'...wird die Tabelle "Liste" durchsucht...
For llorowlist = 1 To lshList.Cells(lshList.Rows.Count, 1).End(xlUp).Row
'...nur wenn Eintrag aus Spalte J in LISTE gefunden
If InStr(LCase(larClubs(7, liIdx)), LCase(lshList.Range("A" & llorowlist).Value)) > 0 Then
'...merkt sich der Code; die Suche wird beendet
lboHit = True
Exit For
End If
Next
End If
For liIdxC = 0 To 7
If larClubs(liIdxC, liIdx)  "" Then
lboReady = True
Else
lboReady = False
Exit For
End If
Next
Next
If lboReady = True Then
'NUR wenn die weiter oben durchgeführte Suche nach Eintrag Spalte J in LISTE erfolgreich war...
If lboHit = True Then
lboHit = False
lboHit1 = True
slink = Replace(link.href, "about:", "https://www.totalcorner.com")
'...erhält Spalte A den Hyperlink-Eintrag
.Hyperlinks.Add Anchor:=.Cells(iRow, 1), _
Address:=slink, _
TextToDisplay:=larClubs(0, 0)
'...und die übrigen Spalten ihre Einträge
.Cells(iRow, 4) = larClubs(1, 0)
.Cells(iRow, 5) = larClubs(2, 0)
.Cells(iRow, 6) = larClubs(3, 0)
.Cells(iRow, 7) = larClubs(4, 0)
.Cells(iRow, 8) = larClubs(5, 0)
.Cells(iRow, 9) = larClubs(6, 0)
.Cells(iRow, 10) = larClubs(7, 0)
'wenn mehr als 4 Datenzeilen in "LIVE" eingetragen...
If iRow > 4 Then
Ende = .Cells(.Rows.Count, 1).End(xlUp).Row
'...vervollständige ich die Formeln in den Spalten ab Spalte L sofort - du hast das erst nach Eintragen aller Datenzeilen gemacht, was ja hin und wieder zum Fehler führte
.Range("L4:BX4").AutoFill Destination:=Range("L4:BX" & Ende), Type:=xlFillDefault
End If
iRow = iRow + 1
End If
ReDim larClubs(7, 0)
Exit For
End If
Next
End If
DoEvents 'ist erforderlich, weil ich feststellte, dass sich Excel manchmal "aufhängt", wenn das Durchsuchen der Internetseite zu lange dauert; mehr Infos zu DoEvents bei google
End If
DoEvents
Next
End With
End If
Set lshList = Nothing
Set objXMLHTTP = Nothing
Set html = Nothing
Set html1 = Nothing
Call datumLive
Call daten_autofill
Application.ScreenUpdating = True
If lboHit1 = True Then
lboHit1 = False
Else
MsgBox "Keine Einträge aus Tabelle ''Liste'' enthalten.", vbExclamation, "Info"
End If
End Sub

Sub Aufruf()
Call URL_Load("https://www.totalcorner.com/match/today")
End Sub
Private Sub URL_Load(ByVal sURL As String)
Dim appIE As Object
Dim sTxt As String
Set appIE = CreateObject("InternetExplorer.Application")
appIE.navigate sURL
Do: Loop Until appIE.Busy = False
Do: Loop Until appIE.Busy = False
sTxt = appIE.document.DocumentElement.outerHTML
Set appIE = Nothing
Close
Open ThisWorkbook.Path & "\aufruf.txt" For Output As #1
Print #1, sTxt
Close
MsgBox "Der Text wurde gespeichert unter:" & vbLf & _
Application.Path & "\aufruf.txt"
End Sub