AW: Webseite mit Selektion in Excel einlesen
22.03.2019 10:23:12
Zwenn
Hallo Rob,
klar, so umfangreich ist der Quellcode nicht. Ich hatte mich nur für eine Datei entschieden, weil Jürgen angegeben hat, er habe keine VBA Kenntnisse. So muss er den Code nicht selbst in eine Mappe integrieren.
Im Code findest Du fireEvent. Das ist eine alte Methode, um Events einer Seite zu triggern. Für diese Seite funktioniert es aber. Eigentlich soll man dispatchEvent nutzen. Da muss man aber noch mehr drum rum basteln und ich stehe mit Events auf Webseiten irgendwie auf Kriegsfuß. Deshalb bin ich ganz froh, das fireEvent funktioniert ;-)
Im Allgemeinen kannst Du Webseiten über das DOM (Document Object Model) auslesen, falls es nicht mit PowerQuery geht oder PQ ungeeignet für das Ziel des Auslesens ist.
Sub TextAusHTML()
'Variablen für den Internetzugriff und das DOM-Handling
Dim url As String
Dim browser As Object
Dim knotenWurzel As Object
Dim knotenStamm As Object
Dim knotenAst As Object
Dim knotenZweig As Object
Dim knotenBlatt As Object
Dim datum As Date
Dim gueltigBis As String
Dim ankaufPreis As Double
Dim verkaufUnverarbeitetPreis As Double
Dim verkaufVerarbeitetPreis As Double
Dim aktuelleZeile As Long
aktuelleZeile = 2
url = "https://pm-prices.heraeus.com/Heraeus_HistoricalPrices.aspx?Lang=DE&Minor=FALSE"
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
browser.Navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Dropbox auswählen
Set knotenWurzel = browser.document.getElementByID("ctl00_ContentPlaceHolder1_ddlMetal")
'Eintrag Ag wählen,
'ChangeEvent auslösen und
'warten bis Seite mit Werten für Silber geladen wurde
knotenWurzel.selectedIndex = 1
knotenWurzel.fireEvent ("onchange")
Application.Wait (Now + TimeSerial(0, 0, 5))
Do Until browser.ReadyState = 4: DoEvents: Loop
'Daten-Tabelle holen
Set knotenStamm = browser.document.getElementByID("ctl00_ContentPlaceHolder1_gridviewReport")
If Not knotenStamm Is Nothing Then
Set knotenAst = knotenStamm.getElementsByTagName("tr")
If Not knotenAst Is Nothing Then
'Wenn vorhanden, Zeilen durchgehen
For Each knotenZweig In knotenAst
'Alle Zellen der Zeile einsammeln
Set knotenBlatt = knotenZweig.getElementsByTagName("td")(0)
If Not knotenBlatt Is Nothing Then
'Auf Datum Prüfen
If IsDate(knotenBlatt.innertext) Then
'Datum speichern
datum = knotenBlatt.innertext
Else
'Wenn kein Datum ist es die vorletzte Zeile mit den Zwischenstrichen
'Dann Schleife verlassen
Exit For
End If
End If
Set knotenBlatt = knotenZweig.getElementsByTagName("td")(1)
If Not knotenBlatt Is Nothing Then
gueltigBis = knotenBlatt.innertext
End If
Set knotenBlatt = knotenZweig.getElementsByTagName("td")(2)
If Not knotenBlatt Is Nothing Then
ankaufPreis = knotenBlatt.innertext
End If
Set knotenBlatt = knotenZweig.getElementsByTagName("td")(3)
If Not knotenBlatt Is Nothing Then
verkaufUnverarbeitetPreis = knotenBlatt.innertext
End If
Set knotenBlatt = knotenZweig.getElementsByTagName("td")(4)
If Not knotenBlatt Is Nothing Then
verkaufVerarbeitetPreis = knotenBlatt.innertext
End If
'Werte in Tabelle eintragen, aus der das Datum gestartet wurde
Cells(aktuelleZeile, 1).Value = datum
Cells(aktuelleZeile, 2).Value = gueltigBis
Cells(aktuelleZeile, 3).Value = ankaufPreis
Cells(aktuelleZeile, 4).Value = verkaufUnverarbeitetPreis
Cells(aktuelleZeile, 5).Value = verkaufVerarbeitetPreis
'Zeile nur hochzählen, wenn in der ersten Spalte der
'aktuellen Zeile ein Datum eingetragen wurde
'Hintergrund: In der ersten Zeile der Tabelle ist die
'Kopfzeile eingetragen. Diese wird so übergangen
If CLng(Cells(aktuelleZeile, 1).Value) 0 Then
aktuelleZeile = aktuelleZeile + 1
End If
Next knotenZweig
End If
End If
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
Set knotenZweig = Nothing
Set knotenBlatt = Nothing
End Sub
Unter folgendem Link findest Du ein größeres und ausführlicher kommentiertes Projekt. Den Quellcode hier zu Posten funktioniert so aber nicht. Das Forum würde viele Zeilenumbrüche einfügen, die den Code unleserlich und vermutlich auch in der abgebildeten Form unbrauchbar machen würden. Außerdem gehören die Tabellen mit zum Funktionsumfang:
https://www.herber.de/cgi-bin/callthread.pl?index=1678466
Viele Grüße,
Zwenn