Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

VBA Web scraping Hilfe

nach unten

Betrifft: VBA Web scraping Hilfe von: Andre Langer
Geschrieben am: 26.10.2020 01:06:34

Guten Abend, ich habe ein Problem beim Auslesen der Daten. Hoffentlich kann mir jemand helfen.

Ich will von einer Internetseite (in NL) alle von vergangenen Veranstaltungen auslesen.

Leider schreibt er alles in eine Zeile:



Kann mir jemand erklären, wie ich alles in eine extra Zelle bekomme?

Hier noch mein code:

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

nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: Hajo_Zi
Geschrieben am: 26.10.2020 05:42:53

Daten, Text in Spalten.

GrußformelHomepage

nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: volti
Geschrieben am: 26.10.2020 08:45:41

Hallo Andre,

schau mal, ob Du mit einer Einzelabholung besser hinkommst....


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
 
viele Grüße
Karl-Heinz


nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: Günther
Geschrieben am: 26.10.2020 08:50:23

Moin,
leider (ich vertrete die Meinung "Gott sei Dank") ignoriert Power Query noch nicht einmal nette Bildchen… Sonst wäre das damit gewiss gut machbar.
 
Gruß
Günther  |  mein Excel-Blog

nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: Andre Langer
Geschrieben am: 26.10.2020 12:09:16

@volti. Danke das ist genau wonach ich gefragt habe. Funktioniert soweit super.

Eine Kleinigkeit hätte ich aber noch. Ich brauch nur die Daten der vergangenen Veranstaltungen. Also ab: 

h2 class="infoblock__title"
Kann man das noch hinzufügen?

@Günther

Powerquery funktioniert tatsächlich nicht bzw. nur sehr beschränkt. 😉

nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: volti
Geschrieben am: 26.10.2020 12:46:47

Hallo,

H2 ist ein anderes Tag und auch die Class ist auch anders. Das mit der einfachen Abfrage zu verquicken kompliziert das.

Um nicht noch weitere Abfragen da mit rein zu bringen, würde ich jetzt einfach die Schleifen vorher abbrechen, also nicht bis .length gehen oder nur index 0 (Überschrift) und ab index x bis index y gehen.

viele Grüße
Karl-Heinz

nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: volti
Geschrieben am: 26.10.2020 15:08:24

Also ich habe nochmal reingeschaut.

Mit dem <H2> kann man in diesem Zusammenhang nichts anfangen, weil das bei der Auswertung der <div>-Tags mit den entsprechenden Classnames ja nicht auftaucht.

Geht man davon aus, dass bis zum H2 ggf. auch mehrere Termine liegen können, muss man sich die zweite Datumsposition suchen.

Vielleicht ist anliegende Version dazu geeignet.
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

____________
viele Grüße 😊
Karl-Heinz


nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: Andre Langer
Geschrieben am: 27.10.2020 11:45:56

Ecuh allen vielen dank für die Hilfe, werde mich heute nacht nach der Arbeit gleich mal ran setzen, auf jeden Fall nochmal 1000 dank, und bleibt alle sgesund und munter.

nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: Zwenn
Geschrieben am: 26.10.2020 18:52:43

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

nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: volti
Geschrieben am: 26.10.2020 19:38:49

Nö Zwenn,

alles gut.

Ich hatte mich (aus Zeitgründen und als Weiterentwicklung der Vorlage) nicht so intensiv damit beschäftigt.

viele Grüße
Karl-Heinz

nach oben  nach unten

Betrifft: Ok, alles klar :-) [owT]
von: Zwenn
Geschrieben am: 26.10.2020 23:57:55



nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: Andre Langer
Geschrieben am: 28.10.2020 12:34:41

Guten morgen,
Wenn ich 
Dim eventDateAsDate As Date
ändere in 
Dim eventDateAsDate As String
macht der Code jetzt exact was ich gefragt hatte. Vielen Danke nochmal dafür.

Ein kleines Problem habe ich jedoch noch:

Ein Teil der URL soll variabel sein, heißt ich habe eine Tabelle wo drinsteht:
612799/VIVORYON-THERAPEUT
bzw.
613005/NIBC-Holding-NV
usw.

Bei den anderen Makros die ich habe konnte ich das lösen mit:
gorid = ActiveCell.Value

https://www.beursgorilla.nl/Aandeel-Koers/"
 & gorid & "/ Agenda.aspx
Bei Const Anweisungen funktioniert das laut google aber nicht so einfach.

Gibt es hierfür auch eine Lösung?

nach oben  nach unten

Betrifft: AW: VBA Web scraping Hilfe
von: Zwenn
Geschrieben am: 28.10.2020 13:47:45

Hallo Andre,

das Du das Datum als String wolltest war mir nicht klar. Gibts dafür einen bestimmten Grund? Bin nur Neugierig. Du kannst es so lassen, kannst den Blub mit eventDateAsDate aber auch einfach löschen und eventDate in die Zellen eintragen lassen. Das ist ja bereits ein String.

Const ist das Schlüsselwort, um eine Konstante zu definieren. Die kann man zur Laufzeit nicht ändern. Du kannst die Konstante mit Dim als Variable deklarieren. Du musst dann halt die URL in Deiner Schleife einsetzen, wie Du es vorher gemacht hast.

Viele Grüße,

Zwenn