Sub test()
Dim req As New MSXML2.XMLHTTP60
Dim reqURL As String
req.Open "GET", reqURL, False
req.send
If req.Status <> 200 Then
MsgBox req.Status & " - " & req.statusText
Exit Sub
End If
ParseWiseOwlVideos req.responseText
End Sub
Sub ParseWiseOwlVideos(HTMLString As String)
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim WolVideos As MSHTML.IHTMLElementCollection
Dim WolVideo As MSHTML.IHTMLElement
Dim WolVideoItem As MSHTML.IHTMLElement
Dim RowNum As Long, ColNum As Long
Dim hrefText As String
Dim OutputSheet As Worksheet
HTMLDoc.body.innerHTML = HTMLString
Set WolVideos = HTMLDoc.getElementsByClassName("woVideoListRow")
If WolVideos.Length = 0 Then: MsgBox "Ausgang": Exit Sub
Set OutputSheet = Worksheets.Add
With OutputSheet
.Range("A1") = "A"
.Range("B1") = "B"
.Range("C1") = "C"
.Range("A1:C1").Interior.Color = rgbCornflowerBlue
End With
RowNum = 1
For Each WolVideo In WolVideos
RowNum = RowNum + 1
ColNum = 0
For Each WolVideoItem In WolVideo.Children
ColNum = ColNum + 1
OutputSheet.Cells(RowNum, ColNum) = WolVideoItem.innerText
If ColNum = 1 Then
hrefText = WolVideoItem.getElementsByTagName("a")(0).href
OutputSheet.Cells(RowNum, ColNum).Hyperlink.Add _
Anchor:=OutputSheet.Cells(RowNum, ColNum), _
End If
Next WolVideoItem
Next WolVideo
OutputSheet.Range("A1").CurrentRegion.EntireColumn.AutoFit
MsgBox "Fertig"
End Sub