AW: MSXML2
31.05.2019 18:58:11
Zwenn
Hallo Martin,
da Fennek heute wohl keine Zeit mehr hatte, gebe ich Dir mal eine Lösung, wie er sie gedacht hatte. Fennek arbeitet immer mit MSXML2, während ich immer über den Internet Explorer gehe. Das Ergebnis ist aber das Gleiche.
Die Lösung aus dem von Dir Verlinkten Video klappt für Dein Vorhaben nicht. Wie es im Video erklärt ist, habe ich auch mal angefangen. Da stößt man aber sehr schnell an die Grenzen des damit Machbaren. Deshalb geht man über das sogenannte DOM (Document Object Model). Das ist eine spezifizierte Schnittstelle, über die jeder Browser Internetseiten in einer Baumstruktur verwaltet.
Über bestimmte Befehle (die Get-Methoden) kommt man oft ans Ziel. Zusätzlich ist es hilfreich zu wissen, dass sich sehr viele Informationen im HTML-Quelltext verbergen, die auf einer Seite selbst gar nicht zu sehen sind. So ist es auch hier. Die Werte für Deine beiden Teams stehen in Attributen von HTML-Tags. Die kann man auslesen und dann so verarbeiten, wie man es braucht.
Um Deine UserIDs alle abzuklappern, brauchst Du das folgende Makro nur anpassen und eine Schleife um den entsprechenden Quelltext legen. Ich habe Dir markiert wo:
Sub LuffyVsKatakuri()
Const grundURL As String = "https://trecru-ww.channel.or.jp/luffy-vs-katakuri/ranking?user_id="
Dim browser As Object
Dim knotenWurzel As Object
Dim knotenStamm As Object
Dim knotenAst As Object
Dim url As String
Dim userID As String
Dim geholtesAttribut As String
Dim splitArray() As String
Dim ergebnis As String 'Hier nur um die ausgelesenen Werte in einer MsgBox auszugeben
'Anfang einer Schleife über alle userIDs
userID = "932044119" 'In der Praxis in einer Schleife nacheinander aus einer Tabelle holen
url = grundURL & userID
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
Set browser = CreateObject("internetexplorer.application")
browser.Visible = False
browser.Navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Richtigen div-Tag in NodeCollection schreiben
Set knotenWurzel = browser.document.getElementsByClassName("yourScore")(0)
If Not knotenWurzel Is Nothing Then
'Die drei gewünschten Werte aus den Attributen der dd-Tags auslesen
'Die drei dl-Tags in eine NodeCollection schreiben
Set knotenStamm = knotenWurzel.getElementsByTagName("dl")
If Not knotenStamm Is Nothing Then
'Erster dd-Tag enthält das Ranking
'Ausgabestring für dieses Demo-Makro vorbereiten
ergebnis = ergebnis & "Werte für UserID: " & userID & Chr(13) & Chr(13) & "Your Ranking" & _
Chr(13)
'dd-Tag aus dem ersten Element der NodeList von KnotenStamm in eigene NodeList schreiben
Set knotenAst = knotenStamm(0).getElementsByTagName("dd")(0)
'Das Attribut data-ranks auslesen
'Das sieht so aus: {"luffy":1187,"katakuri":188}
geholtesAttribut = knotenAst.getAttribute("data-ranks")
'Eleminieren aller überflüssigen Zeichen, außer der Zahlen und dem trennenden Komma
'Chr(34) ist das Anführungszeichen "
'Chr steht für Character = Zeichen und 34 ist der Code des Zeichens
geholtesAttribut = Replace(geholtesAttribut, "{" & Chr(34) & "luffy" & Chr(34) & ":", "")
geholtesAttribut = Replace(geholtesAttribut, Chr(34) & "katakuri" & Chr(34) & ":", "")
geholtesAttribut = Replace(geholtesAttribut, "}", "")
'Übrig gebliebener String sieht jetzt so aus: 1187,188
'Diesen teilen wir mit Split am Komma in ein zweielementiges Array auf
splitArray = Split(geholtesAttribut, ",")
'Das erste und das zweite Array Element enthalten nun unsere gesuchten Zahlen
'Im Demo-Makro schreiben wir sie in den ergebnis-String. In der Praxis werden
'die Werte vermutlich in eine Tabelle geschrieben. Da muss halt zusätzlich
'jeweils Zeile und Spalte für die richtige Zelle mitgepflegt werden
ergebnis = ergebnis & "Luffy: " & Chr(9) & Chr(9) & splitArray(0) & Chr(13)
ergebnis = ergebnis & "Katakuri: " & Chr(9) & splitArray(1) & Chr(13) & Chr(13)
'Hier wiederholt das Ganze für das Attribut data-scores im zweiten dd-Tag
ergebnis = ergebnis & "Your Face-Off Pts" & Chr(13)
Set knotenAst = knotenStamm(1).getElementsByTagName("dd")(0)
geholtesAttribut = knotenAst.getAttribute("data-scores")
geholtesAttribut = Replace(geholtesAttribut, "{" & Chr(34) & "luffy" & Chr(34) & ":", "")
geholtesAttribut = Replace(geholtesAttribut, Chr(34) & "katakuri" & Chr(34) & ":", "")
geholtesAttribut = Replace(geholtesAttribut, "}", "")
splitArray = Split(geholtesAttribut, ",")
ergebnis = ergebnis & "Luffy: " & Chr(9) & Chr(9) & splitArray(0) & Chr(13)
ergebnis = ergebnis & "Katakuri: " & Chr(9) & splitArray(1) & Chr(13) & Chr(13)
'Hier wiederholt das Ganze für das Attribut data-next im dritten dd-Tag
ergebnis = ergebnis & "Until Next Rank" & Chr(13)
Set knotenAst = knotenStamm(2).getElementsByTagName("dd")(0)
geholtesAttribut = knotenAst.getAttribute("data-next")
geholtesAttribut = Replace(geholtesAttribut, "{" & Chr(34) & "luffy" & Chr(34) & ":", "")
geholtesAttribut = Replace(geholtesAttribut, Chr(34) & "katakuri" & Chr(34) & ":", "")
geholtesAttribut = Replace(geholtesAttribut, "}", "")
splitArray = Split(geholtesAttribut, ",")
ergebnis = ergebnis & "Luffy: " & Chr(9) & Chr(9) & splitArray(0) & Chr(13)
ergebnis = ergebnis & "Katakuri: " & Chr(9) & splitArray(1) & Chr(13)
End If
End If
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenWurzel = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
'Ausgelesene Werte zur Veranschaulichung anzeigen
MsgBox ergebnis
'Ende einer Schleife über alle UserIDs
End Sub
Viele Grüße,
Zwenn