AW: Mal wieder über das DOM
28.06.2018 21:00:56
Zwenn
Hallo Meiko,
da Du sagtest, es sieht so aus, als ob der IE ein zweites Mal geöffnet wird, habe ich nochmal nachgedacht. Dann wäre der erste vom Makro geöffnete IE weg. Sollte das aus irgend einem unerfindlichen Grund so sein, würde die Variable browser nix mehr enthalten, worauf der Folgecode zugreifen könnte und dann würde ich das von Dir beschriebene Verhalten erwarten.
Mein Nachdeneken hat auch zu einem Ergebnis geführt ;-) Nachdem der Browser das erste Mal die Seite lädt, kann er unter allen geöffneten Programmen einfach (wieder) gesucht werden. Sollte er verloren gegangen sein, weil eine andere Instanz geöffnet wurde, wird er nun vom aktualisierten Makro wieder "eingefangen". Auf meinem Rechner sind nach Abschluss des Makros deshalb 2 IE Instanzen geöffnet gewesen (bei mir geht er halt nicht verloren, aber der Code muss in beiden Fällen laufen), von denen nur eine sichbar war. Deshalb habe ich jetzt doch das Schließen des Browsers mit eingebaut und setze auch alle Objektvariablen zurück. Deshalb wirkt der Code etwas aufgebläht. Vor allem auch, weil das an drei Stellen passieren muss. Ginge auch anders, aber ich verwende kein GoTo ;-)
Probiere mal aus, ob das so bei Dir läuft. Ich habe Deine 20 Sekunden für das Warten auf das vollständige Laden des Dokuments auf 5 Sekunden herab gesetzt. Musst Du evtl. wieder anpassen. Danach wird der Browser neu gesucht. Wenn das durchläuft und der Button angeklickt wird, wie Programmiert, ist das schonmal gut. Sollte das Makro dann bei der zweiten Pause, bzw danach, wieder aussteigen, muss an der Browser an der Stelle auch nochmal gesucht werden. Ich gehe aber erstmal davon aus, das der Klick auf einen Button keine neue Browser Instanz auslöst. Sofern diese Idee überhaupt im Ansatz richtig sein sollte.
Hier ist der angepasste Code:
Sub ZollKurseHolen()
Dim objShell As Object
Dim browserSuchen As Object
Dim browser As Object
Dim url As String
Dim knoten As Object
Dim knotenStamm As Object
Dim knotenAst As Object
Dim knotenZweig As Object
Dim knotenBlatt As Object
Dim spalte As Byte
Dim zeile As Byte
Dim nummernCheck As String
'Davon ausgehend, dass als Datumsgrenzen immer der aktuelle Monat gewählt wird
'kann man die ganzen Parameter im Link weglassen
url = "http://www.zoll.de/SiteGlobals/Forms/KursSuche/KurseSuche_Formular_NotierteWaehrung.html" _
'Internet Explorer initialisieren und Sichtbarkeit festlegen
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
'Seite im IE aufrufen und warten bis sie vollständig geladen ist
browser.Navigate url
Application.Wait (Now + TimeSerial(0, 0, 5))
'IE neu suchen, falls verloren gegangen
Set objShell = CreateObject("Shell.Application")
For Each browserSuchen In objShell.Windows
If InStr(1, UCase(browserSuchen.FullName), "IEXPLORE") > 0 Then
If browserSuchen.Document.Location = url Then
Exit For
End If
End If
Next
'Button "Kurse anzeigen" suchen, anklicken und
'5 Sekunden warten um die Seite neu zu laden
Set knotenAst = browserSuchen.Document.getElementsByClassName("submit")(0)
If Not knotenAst Is Nothing Then
knotenAst.Click
Application.Wait (Now + TimeSerial(0, 0, 5))
'Do Until browserSuchen.readyState = 4: DoEvents: Loop
Else
MsgBox "Der Button 'Kurse anzeigen' wurde nicht gefunden"
'Aufräumen und beenden
If Not browser Is Nothing Then
browser.Quit
End If
If Not browserSuchen Is Nothing Then
browserSuchen.Quit
End If
Set browser = Nothing
Set browserSuchen = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
Set knotenZweig = Nothing
Set knotenBlatt = Nothing
Set knoten = Nothing
Exit Sub
End If
'Kopfzeile schreiben
Cells(1, 1).Value = "Land"
Cells(1, 2).Value = "ISO-Alpha-2 Code"
Cells(1, 3).Value = "1 EUR ="
Cells(1, 4).Value = "ISO-Alpha-3 Code"
Cells(1, 5).Value = "Gültigkeit"
Cells(1, 6).Value = "Anmerkungen"
'Werte auslesen und in die Tabelle schreiben
Set knotenStamm = browserSuchen.Document.getElementsByTagName("tbody")(0)
If Not knotenStamm Is Nothing Then
Set knotenAst = knotenStamm.getElementsByTagName("tr")
spalte = 1
zeile = 2
For Each knotenZweig In knotenAst
'Land auslesen
Set knotenBlatt = knotenZweig.getElementsByTagName("th")(0)
Cells(zeile, spalte).Value = knotenBlatt.innertext
Cells(zeile, spalte).Value = Trim(Cells(zeile, spalte).Value)
spalte = spalte + 1
'Rest auslesen
Set knotenBlatt = knotenZweig.getElementsByTagName("td")
For Each knoten In knotenBlatt
nummernCheck = knoten.innertext
If IsNumeric(Trim(nummernCheck)) Then
Cells(zeile, spalte).Value = Trim(nummernCheck) * 1
Else
Cells(zeile, spalte).Value = Trim(nummernCheck)
End If
spalte = spalte + 1
Next knoten
spalte = 1
zeile = zeile + 1
Next knotenZweig
Else
MsgBox "Es wurden keine Kursdaten gefunden"
'Aufräumen und beenden
If Not browser Is Nothing Then
browser.Quit
End If
If Not browserSuchen Is Nothing Then
browserSuchen.Quit
End If
Set browser = Nothing
Set browserSuchen = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
Set knotenZweig = Nothing
Set knotenBlatt = Nothing
Set knoten = Nothing
Exit Sub
End If
'Aufräumen und beenden
If Not browser Is Nothing Then
browser.Quit
End If
If Not browserSuchen Is Nothing Then
browserSuchen.Quit
End If
Set browser = Nothing
Set browserSuchen = Nothing
Set knotenStamm = Nothing
Set knotenAst = Nothing
Set knotenZweig = Nothing
Set knotenBlatt = Nothing
Set knoten = Nothing
End Sub
Viele Grüße,
Zwenn