AW: VBA web scraping
11.04.2019 11:52:16
Zwenn
Hallo Torsten,
bei Seiten die als Beispiel dienen sollen bin ich ja immer skeptisch. Ich gehe aber davon aus, dass andere Seiten, die Du auslesen möchtest, den gleichen Aufbau haben, also auch Spielerseiten sind. Wenn nicht, klappt nicht, was Du vor hast.
Was auf keinen Fall geht, ist die Verwendung des Chrome Browsers. Man muss den Internet Explorer nehmen, weil das der Einzige ist, den man über die sogenannte COM-Schnittstelle direkt aus Excel ansprechen kann. Alle anderen Browser haben keine COM-Schnittstelle. Solltest Du auf einem Mac arbeiten, funktioniert das folgende Makro also nicht, da es dort keinen Internet Explorer gibt.
Die Ausgabe der Ergebnisse musst Du Dir anpassen. Ich sammel die einfach in einem String und gebe den am Ende aus.
Sub WerteAuslesen()
'Variablen für den Internetzugriff und das DOM-Handling
Dim url As String
Dim browser As Object
Dim knotenStamm As Object
Dim knotenAst As Object
Dim knotenZweig As Object
Dim textAusFaehigkeit As String
Dim faehigkeitGefunden As Boolean
Dim ergebnis As String
'Adresse der auszulesenden Seite
url = "https://trainingslager.onlineliga.de/player/overview?playerId=1668"
'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
'Alle Spieler-Fähigkeiten in eine Node Collection einsammeln
Set knotenStamm = browser.document.getElementsByClassName("row ol-playerabilitys-table-row")
If Not knotenStamm Is Nothing Then
'Wenn Spieler-Fähigkeiten vorhanden sind,
'alle durchgehen und die gewünschten Werte auslesen
For Each knotenAst In knotenStamm
'Den Text des grade bearbeiteten Wertes auslesen
textAusFaehigkeit = knotenAst.innertext
'Wenn gewünschter Fähigkeiten-Name enthalten, Wert auslesen
If InStr(1, textAusFaehigkeit, "Fitness") > 0 Or _
InStr(1, textAusFaehigkeit, "Kondition") > 0 Then
faehigkeitGefunden = True
End If
Select Case faehigkeitGefunden
Case True
Set knotenZweig = knotenAst.getElementsByClassName _
("ol-value-bar-small-label-value")(0)
If Not knotenZweig Is Nothing Then
'Wenn der Wert vorhanden ist, speichern
'Der Wert kann auch direkt in einer Tabelle abgelegt werden
'Die Reihenfolge der Augabe entspricht der Reihenfolge der
'Werte auf der Internetseite
ergebnis = ergebnis & Trim(knotenZweig.innertext) & Chr(13)
End If
End Select
'Gefunden-Status zurücksetzen
faehigkeitGefunden = False
Next knotenAst
Else
'Wenn keine Spieler-Fähigkeiten ausgelesen werden konnten,
'Hinweis als Ergebnis speichern
ergebnis = "Es wurden keine Spieler-Fähigkeiten gefunden."
End If
'Ergebnis ausgeben
MsgBox ergebnis
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
Set knotenZweig = Nothing
End Sub
Viele Grüße,
Zwenn