VBA-Daten Scraping nicht über IE
15.10.2019 16:17:41
Fred
Hallo Excel&VBA Experten,
vor über einem Jahr hat mir Zwenn folgendes Makro geschrieben, welches mir Spielergebnisse der 3. Liga ins Excel holt:
Sub FussballErgebnisseHolen()
Dim browser As Object
Dim url As String
Dim knotenStamm As Object
Dim knotenAst As Object
Dim knotenZweig As Object
Dim knotenBlatt As Object
Dim zeile As Long
Dim spalte As Byte
Dim index As Byte
Dim splitArray() As String
'Variablen initialisieren
zeile = 2
spalte = 1
url = "https://www.soccerstats.com/results.asp?league=germany3"
'Kopfzeile schreiben
Cells(1, 1).Value = "Datum"
Cells(1, 2).Value = "Uhrzeit"
Cells(1, 3).Value = "Heimmannschaft"
Cells(1, 4).Value = "Gastmannschaft"
Cells(1, 5).Value = "Heim"
Cells(1, 6).Value = "Gast"
Cells(1, 7).Value = "Halbzeit"
Range("A1:G1").Font.Bold = True
Range("A1:G1").HorizontalAlignment = xlCenter
Columns("B:B").HorizontalAlignment = xlCenter
Columns("E:G").HorizontalAlignment = xlCenter
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'Seite aufrufen und warten, bis sie ganz geladen wurde
Set browser = CreateObject("internetexplorer.application")
browser.Visible = False
browser.navigate url
Do Until browser.readyState = 4: DoEvents: Loop
'Quelltext aus dem Body des richtigen iFrames
'holen, in dem die Ergebnisse aufgelistet sind
Set knotenStamm = browser.document.getElementByID("pmatch") _
.contentDocument.getElementsByTagName("body")(0)
If Not knotenStamm Is Nothing Then
'Relevante Tabellenzeilen einsammeln
Set knotenAst = knotenStamm.getElementsByClassName("odd")
If Not knotenAst Is Nothing Then
For Each knotenZweig In knotenAst
'Tabellenzellen der aktuellen Begegnung einsammeln
Set knotenBlatt = knotenZweig.getElementsByTagName("td")
If Not knotenBlatt Is Nothing Then
'Zellen einer Begegnung in die Excel Tabelle schreiben
'Dafür jeden Index durchgehen, weil Begegnungen, die
'noch nicht stattgefunden haben weniger Zellen haben
For index = 0 To Len(knotenBlatt)
'Datum (hier nicht auf Deutsch umgearbeitet und
'deshalb kein echtes Excel-Datum)
If index = 0 Then
Cells(zeile, spalte).Value = knotenBlatt(index).innertext
End If
'Uhrzeit
If index = 1 Then
Cells(zeile, spalte).Value = knotenBlatt(index).innertext
'1 h abziehen. Keine Ahnung warum die Uhrzeit um 1 h mehr
'ausgelesen wird. Vielleicht weil es eine britische Seite
'ist und Excel sich für schlau hält. So werden die Zeiten
'jedenfalls angezeigt, wie in der Tabelle
Cells(zeile, spalte).Value = Cells(zeile, spalte).Value _
- 4.16666666666667E-02
End If
'Heim- und Gast-Mannschaft
If index = 2 Then
'Mannschaften separieren
splitArray = Split(knotenBlatt(index).innertext, "-")
Cells(zeile, spalte).Value = Trim(splitArray(0))
spalte = spalte + 1
Cells(zeile, spalte).Value = Trim(splitArray(1))
End If
If index = 3 Then
'Ergebnis separieren
splitArray = Split(knotenBlatt(index).innertext, "-")
If IsNumeric(Trim(splitArray(0))) Then
Cells(zeile, spalte).Value = Trim(splitArray(0)) * 1
End If
spalte = spalte + 1
If UBound(splitArray) > 0 Then
If IsNumeric(Trim(splitArray(1))) Then
Cells(zeile, spalte).Value = Trim(splitArray(1)) * 1
End If
End If
End If
'Halbzeitstand
On Error Resume Next
If index = 4 Then
Cells(zeile, spalte).Value = knotenBlatt(index).innertext
End If
On Error GoTo 0
spalte = spalte + 1
Next index
spalte = 1
zeile = zeile + 1
End If
Next knotenZweig
End If
End If
'Spalten auf die richtige Breite setzen
Columns("A:G").EntireColumn.AutoFit
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
Set knotenZweig = Nothing
Set knotenBlatt = Nothing
end sub()
Meine Frage;Der Zugang zu den Daten geschieht ja über den IE
Ist es möglich, dass dies auch über Chrome oder Firefox klappt?
Mit freundlichen Gruß
Fred