html auslesen

Sub seite1()

    Dim doc As New HTMLDocument

    Dim games As IHTMLElementCollection

    Dim game As IHTMLElement6

    Dim ws As Worksheet

    Dim endRow As Long

    

    Set ws = ThisWorkbook.Sheets("Prediction")

    endRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    

    Let r = 0

    Let c = 0

    Call Tabelle1.Range("A5:P" & endRow).ClearContents

    With New WinHttp.WinHttpRequest

        Call .Open("GET", "https://primatips.com/facts/" & Tabelle1.Range("A1") & "")

        Call .send

        Set doc = New HTMLDocument

        Let doc.body.innerHTML = .responseText

        Set games = doc.getElementById("main").getElementsByTagName("a")

        ReDim a(1 To games.Length, 1 To MAXC)

        For Each game In games

            Let c = 0

            Let r = r + 1

            Call WriteColums(game.getElementsByClassName("ht1"))

            Call WriteColums(game.getElementsByClassName("at1"))

            Call WriteColums(game.getElementsByClassName("res"))

            Call WriteColums(game.getElementsByClassName("status"))

            Call WriteColums(game.getElementsByClassName("xxx"))

            Call WriteColums(game.getElementsByClassName("xxx"))

            Call WriteColums(game.getElementsByClassName("xxx"))

            Call WriteColums(game.getElementsByClassName("xxx"))

        Next

        Let Tabelle1.Range(Cells(5, 1), Cells(4 + r, UBound(a(), 2))) = a()

    End With

End Sub

Private Sub WriteInnerTextToCell(p As IHTMLElement)

    Let c = c + 1

    If c = UBound(a(), 2) Then Let a(r, c) = p.innerText

End Sub

Private Sub WriteColums(p As IHTMLElementCollection)

    Dim e As IHTMLElement

    For Each e In p

        Call WriteInnerTextToCell(e)

    Next

End Sub