AW: Webseite Zahl auslesen
15.05.2019 17:30:46
Zwenn
Hallo Bernd,
vermeide diese Ketten aus GetMethoden. Wenn eine davon nicht matcht, bekommst Du einen Laufzeitfehler, weil das entsprechende Objekt nicht gebildet werden konnte.
Da Du nur Werte zu zwei Angaben haben möchtest, kannst Du das folgendermaßen machen. Das ist zwar sehr stumpf, weil ich unten quasi das gleiche für jedes Werte-Tupel mache, aber für eine elegantere Lösung fehlt mir grade die Zeit. Bin auf dem Sprung.
Sub wsjWerteAuslesen()
Dim browser As Object
Dim url As String
Dim knotenWurzel As Object
Dim knotenStamm As Object
Dim knotenAst As Object
Dim knotenZweig As Object
Dim ergebnis As String
url = "http://www.wsj.com/mdc/public/page/2_3021-tradingdiary2.html"
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
Set browser = CreateObject("internetexplorer.application")
browser.Visible = False
browser.Navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Richtige Tabelle holen
Set knotenWurzel = browser.document.getElementsByClassName("mdcTable")(0)
If Not knotenWurzel Is Nothing Then
'Wenn Tabelle gefunden, NodeList aus tr-Tags bilden
Set knotenStamm = knotenWurzel.getElementsByTagName("tr")
If Not knotenStamm Is Nothing Then
'Wenn tr-Tags vorhanden, direkt aus den richtigen die td-Tags holen
'Ich habe die einfach abgezählt, wobei 0 = das erste tr-Tag ist
'2tes tr-Tag enthält Werte für NYSE -> Issues traded
Set knotenAst = knotenStamm(1).getElementsByTagName("td")
If Not knotenAst Is Nothing Then
'Wenn td-Tags vorhanden Inhalte übernehmen
For Each knotenZweig In knotenAst
ergebnis = ergebnis & knotenZweig.innertext & Chr(13)
Next knotenZweig
End If
'Freizeile für Demo-Ergebnis zwischen den Wertzugehörigkeiten
ergebnis = ergebnis & Chr(13)
'20tes tr-Tag enthält Werte für Nasdaq -> Issues traded
Set knotenAst = knotenStamm(19).getElementsByTagName("td")
If Not knotenAst Is Nothing Then
'Wenn td-Tags vorhanden Inhalte übernehmen
For Each knotenZweig In knotenAst
ergebnis = ergebnis & knotenZweig.innertext & Chr(13)
Next knotenZweig
End If
End If
End If
MsgBox ergebnis
'Aufräumen
browser.Quit
End Sub
Viele Grüße,
Zwenn