VBA Web scraping Hilfe

Sub Import_data() Dim appIE As Object Dim myValue As String Set appIE = CreateObject("internetexplorer.application") With appIE .navigate "https://www.beursgorilla.nl/Aandeel-Koers/612799/VIVORYON-THERAPEUT/Agenda.aspx" .Visible = True End With Do While appIE.Busy DoEvents Loop Set allRowOfData = appIE.document.getElementsByClassName("agendatbl") myValue = allRowOfData(0).innerText appIE.Quit Set appIE = Nothing Range("B1").Value = myValue End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Code: [Cc][+][-] Option Explicit Sub Import_data() Dim appIE As Object, Obj As Object Dim i As Integer, j As Integer, sItems() As String Dim t Set appIE = CreateObject("internetexplorer.application") With appIE .navigate "https://www.beursgorilla.nl/Aandeel-Koers/612799/VIVORYON-THERAPEUT/Agenda.aspx" .Visible = True End With Do While appIE.Busy DoEvents Loop sItems() = Split("agendatbl__date,agendatbl__time,agendatbl__name,agendatbl__city", ",") On Error Resume Next For i = 0 To 3 Set Obj = appIE.document.getElementsByClassName(sItems(i)) For j = 0 To Obj.Length Cells(j + 1, i + 1).Value = Obj(j).innertext Next j Next i appIE.Quit Set appIE = Nothing End Sub

Code: [Cc][+][-] Option Explicit Sub Import_data() Dim appIE As Object, Obj As Object Dim i As Integer, j As Integer, iBegin As Integer Dim sItems() As String, iOutzeile As Long Set appIE = CreateObject("internetexplorer.application") With appIE .navigate "https://www.beursgorilla.nl/Aandeel-Koers/612799/VIVORYON-THERAPEUT/Agenda.aspx" .Visible = True End With Do While appIE.Busy DoEvents Loop sItems() = Split("agendatbl__date,agendatbl__time,agendatbl__name,agendatbl__city", ",") 'Anfang ermitteln Set Obj = appIE.document.getElementsByClassName(sItems(0)) For iBegin = 1 To Obj.Length If Obj(iBegin).innertext Like "Datum" Then Exit For Next iBegin On Error Resume Next For i = 0 To 3 iOutzeile = 1 Set Obj = appIE.document.getElementsByClassName(sItems(i)) For j = iBegin To Obj.Length Cells(iOutzeile, i + 1).Value = Obj(j).innertext iOutzeile = iOutzeile + 1 Next j Next i appIE.Quit Set appIE = Nothing End Sub

Hallo Andre, hallo Karl-Heinz
Ich hoffe ich trete Dir nicht auf die Füße Karl-Heinz, wenn ich eine andere Lösung poste. In den Kommentaren ist eigentlich alles erklärt:


Sub Import_data()
'URL teilen wegen Forums-Zeilen-Umbrüchen
Const url1 = "https://www.beursgorilla.nl/Aandeel-Koers"
Const url2 = "/612799/VIVORYON-THERAPEUT/Agenda.aspx"
Dim nodeCheckReady As Object
Dim nodeHistoryTable As Object
Dim nodeAllHistory As Object
Dim nodeOneHistory As Object
Dim currentRow As Long
Dim currentColumn As Long
Dim eventDate As String
Dim eventDateAsDate As Date
Dim eventName As String
Dim eventTime As String
Dim eventCity As String
'Startzeile und Startspalte initialisieren
currentRow = 2
currentColumn = 1
With CreateObject("internetexplorer.application")
.navigate url1 & url2
.Visible = True 'Auf False setzen für unsichtbar
Do While .Busy: DoEvents: Loop
'Warten, bis Seite auch die nachzuladenden Inhalte zur Verfügung stellt
'Das ist der Fall, sobald die benötigten Tabelleninhalte über ihren
'CSS Klassennamen gefunden werden können
'(Timeout kann man auch einbauen, falls benötigt)
Do
Set nodeCheckReady = .document.querySelector("h2[class='infoblock__title']")
Loop Until Not nodeCheckReady Is Nothing
'Die CSS Klasse agendatbl gibt es 2x im Dokument
'Das zweite Auftreten ist die gewünschte Auflistung
Set nodeHistoryTable = .document.getElementsByClassName("agendatbl")(1)
'Jetzt haben wir das ul-Tag mit allen li-Tags darin
'Wir brauchen alle li-Tags ohne Kopfzeile aus dem ul-Tag
'Das sind alle li-Tags mit der CSS Klasse agendatbl__item
Set nodeAllHistory = nodeHistoryTable.getElementsByClassName("agendatbl__item")
'Zugreifen auf jedes einzelne li-Tag in der NodeCollection
For Each nodeOneHistory In nodeAllHistory
'In den li-Tags stehen die Werte in div-Tags
'Da die div-Tags verschachtelt sind, gäbe es über
'eine NodeCollection mit getElementsByTagNames("div")
'Doppelungen, die man ausfiltern müsste
'Einfacher ist es über die 4 CSS Klassennamen
'Die Reihenfolge kann durch Umstellung der folgenden
'Codeblöcke nach belieben variiert werden
'Übernehmen des Datums
eventDate = nodeOneHistory.getElementsByClassName("agendatbl__date")(0).innertext
eventDate = Replace(eventDate, "-", ".")
eventDateAsDate = eventDate
Cells(currentRow, currentColumn).Value = eventDateAsDate
currentColumn = currentColumn + 1
'Übernehmen des Namens
eventName = nodeOneHistory.getElementsByClassName("agendatbl__name")(0).innertext
Cells(currentRow, currentColumn) = eventName
currentColumn = currentColumn + 1
'Übernehmen der Zeit
eventTime = nodeOneHistory.getElementsByClassName("agendatbl__time")(0).innertext
Cells(currentRow, currentColumn) = eventTime
currentColumn = currentColumn + 1
'Übernehmen der Stadt
eventCity = nodeOneHistory.getElementsByClassName("agendatbl__city")(0).innertext
Cells(currentRow, currentColumn) = eventCity
currentColumn = 1
currentRow = currentRow + 1
Next nodeOneHistory
'Internet Explorer schließen
.Quit
End With 'IE
End Sub

Viele Grüße,
Zwenn

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

147 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Web scraping Hilfe

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

147 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread