Herbers Excel/VBA-Archiv
| Informationen und Beispiele zum Thema MsgBox | |
|---|---|
 Screenshot zu MsgBox |
MsgBox-Seite mit Beispielarbeitsmappe aufrufen |
@michax Kursabfrage
- @michax Kursabfrage von Zwenn vom 26.10.2020 23:47:18
- AW: @michax Kursabfrage - von michax am 30.10.2020 13:18:08
Geschrieben am: 26.10.2020 23:47:18
Hallo michax,
ich hoffe Du findest diesen Thread, da Deiner im Archiv versunken ist:
https://www.herber.de/forum/cgi-bin/callthread.pl?index=1788456
Dein Trick mit dem setzen des Datums über das hidden input field funktioniert nicht mehr. Man muss jetzt wirklich einigen Aufwand betreiben. Deiner Tabelle habe ich entnommen, dass Du immer Werte für das Datum in C1 holst. Das funktioniert jetzt wieder. Ich habe das Ganze neu geschrieben, weil es auch andere Dinge gab, wie die Verhinderung einer Endlosschleife, die ich nicht verstanden habe.
Ich habe alles ausführlich kommentiert. Du solltest also einigermaßen nachvollziehen können, was da passiert. Sollte das Wechseln der Kalenderblätter "stecken bleiben" (ggf. den IE zum Test bei Problemen sichtbar schalten), musst Du evtl. die Zeit von Sleep() nach oben anpassen. Auf meinem Rechner läuft das gut mit 100 mS zwischen dem Rückblätern durch die Monate.
Ich liste hier einmal den VBA Code, damit andere ggf. nicht zwingend die Exceldatei mit Makros runterladen müssen (mag nicht jeder). Ich mache mir dafür allerdings nicht die Mühe, die durch die Fornesoftware verursachten Zeilenumbrüche im Quellcode zu vermeiden. In den Makros habe ich selbst keinen Zeilenumbruch programmiert. Es können also ggf. alle entfernt werden.
In der Tabelle, in der das Makro laufen soll, folgendes Workbook_Change Event Makro eintragen:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = ActiveSheet.Range("C1") Then
KreditKartenWechselKurse
End If
End Sub
In ein allgemeines Modul folgenden Kopf eintragen:
Option Explicit
Option Private Module
#If VBA7 And Win64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Unter den Kopf im allgemeinen Modul das eigentliche Makro kopieren:
Sub KreditKartenWechselKurse()
Const url As String = "https://online.firstdata.com/CurrencyCalculator/fremdwaehrungskurse/ _
calendar"
Dim chosenDate As Date
Dim chosenDateMonthName As String
Dim startRow As Long
Dim currentRow As Long
Dim currentCol As Long
Dim nodeInput As Object
Dim nodeDropdown As Object
Dim nodeCalMonthNav As Object
Dim nodeCalNav As Object
Dim currentCalMonth As String
Dim nodeAllDays As Object
Dim nodeOneDay As Object
Dim nodeResultPage As Object
Dim nodeResult As Object
Dim nodeRow As Object
Dim nodeCell As Object
Dim splitArray() As String
'Variablen initialisieren
startRow = 2
currentCol = 3
'Sicher stellen, dass das Datum für den Abruf innerhalb
'des letzten halben Jahres seit gestern liegt
'Ggf. wird die obere oder untere Datumsgrenze gesetzt
If IsDate(ActiveSheet.Cells(1, 3)) Then
'Steht in C1 ein Datum, dises als gegeben annehmen
chosenDate = CDate(ActiveSheet.Cells(1, 3))
'Prüfen, ob es innerhalb der erlaubten Datumsgrenzen liegt
Select Case chosenDate
Case Is >= Date: chosenDate = Date - 1
Case Is < DateAdd("m", -6, Date): chosenDate = DateAdd("m", -6, Date)
End Select
'Events abschalten, weil wir in C1 schreiben und dies
'das workbook_change Event erneut auslösen würde
Application.EnableEvents = False
'Gewähltes Datum in C3 schreiben
ActiveSheet.Cells(1, 3) = chosenDate
'Events wieder einschalten
Application.EnableEvents = True
Else
'Es steht kein Datum in C1
MsgBox "Bitte ein Datum in Zelle C1 eingeben"
'Makro beenden
Exit Sub
End If
'Alle Währungen durchgehen
For currentRow = startRow To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
With CreateObject("internetexplorer.application")
.Visible = False
.Navigate url
Do Until .ReadyState = 4: DoEvents: Loop
'Pauschal beide Haken in Checkboxen für Kreditkarten setzen
'Das sind die input-Tags mit den Indizes 2 und 3 in der NodeCollection
Set nodeInput = .Document.getElementsByTagName("input")
nodeInput(2).Checked = True
nodeInput(3).Checked = True
'Währung wählen
Set nodeDropdown = .Document.getElementByID("Waehrung")
nodeDropdown.Value = ActiveSheet.Cells(currentRow, 2).Value
'Gewähltes Datum im Kalender auf der Webseite anklicken
'Das ist etwas tricky, weil man dazu ggf. durch die
'letzten 6 Monate navigieren muss
'
'Dazu benötigen wir zunächst den Monatsnamen als Wort,
'um den aktuell angezeigten Monat degegen abzugleichen
chosenDateMonthName = Format(chosenDate, "mmmm")
'
'Das angezeigte Datum im Kalender ist heute
'Also ggf. solange rückwärts durch die Monate
'klicken, bis der gesuchte Monat erreicht wurde
'Durch den anfänglichen Abgleich des Datums
'in C1 gegen das letzte halbe Jahr, liegt der
'gesuchte Monat auf jeden Fall innerhalb der
'letzten sechs Monate
Do
'Rückwärts Monats Navigation des Kalenders zur Verfügung stellen
'Muss nach jedem Monatsaufruf gemacht werden, weil das Element
'sich ändert und damit für die Nutzung verfällt
Set nodeCalMonthNav = .Document.getElementsByClassName("calnavleft")(0)
'
'In der Gesamtnavigation steht der Monat
Set nodeCalNav = .Document.getElementsByClassName("calheader")(0)
'Den Monatsnamen aus dem Text der Navigation extrahieren
'Wir benutzen Split mit dem Standarddelimiter Freizeichen
'Dann ist der Monat das 5. Array Element
splitArray = Split(Trim(nodeCalNav.innertext))
'Klicken, wenn der Monat im Kalender ungleich unserem gesuchten Monat ist
If splitArray(4) <> chosenDateMonthName Then
'Bei Ungleichheit einen Monat zurück navigieren
nodeCalMonthNav.Click
'100 mS warten, um den Kalender neu aufzubauen
'Nach oben anpassen, wenn Zielmonat nicht erreicht wird
Sleep (100)
End If
Loop Until splitArray(4) = chosenDateMonthName
'
'Alle anklickbaren Tage des Kalenderblattes sind a-Tags
Set nodeAllDays = .Document.getElementsByClassName("calbody")(0).getElementsByTagName("a") _
'
'Alle Tage durchgehen und den richtigen anklicken
For Each nodeOneDay In nodeAllDays
'Der Vergleich muss auf den gleichen Datentyp stattfinden
'Wir wandeln deshalb die Zahl des gewählten Datums-Tages
'in einen String um
If nodeOneDay.innertext = CStr(Day(chosenDate)) Then
'Klicken wenn gefunden
nodeOneDay.Click
'Schleife verlassen
Exit For
End If
Next nodeOneDay
'Jetzt kann der Submit-Button geklickt werden
.Document.querySelector("input[value='submit']").Click
'Warten, bis die Ergebnisseite geladen wurde
Do
On Error Resume Next
Set nodeResultPage = .Document.getElementsByClassName("resultsTable")(0)
On Error GoTo 0
Loop Until Not nodeResultPage Is Nothing
'Ergebniszeile in der Excel-Tabelle ausgeben
'aus der das Makro gestartet wurde
Set nodeResult = .Document.getElementsByClassName("even")(0)
Set nodeRow = nodeResult.getElementsByTagName("td")
For Each nodeCell In nodeRow
Cells(currentRow, currentCol) = Trim(nodeCell.innertext)
currentCol = currentCol + 1
Next nodeCell
currentCol = 3
'IE beenden
.Quit
End With
Next currentRow
End Sub
Hier ist das Ganze bereits fertig zusammengebastelt und mit funktionierenden Tabellen dazu:https://www.herber.de/bbs/user/141115.xlsm
Ich hoffe das läuft bei Dir und die ändern nicht so bald wieder etwas ;-)
Viele Grüße,
Zwenn
von: michax
Geschrieben am: 30.10.2020 13:18:08
Hi Zwenn (meine Rettung),
ja habe es gefunden und (ich ziehe abermals meinen Hut vor Dir) es läuft auch bei mir. Toll!!! und wirklich ein riesiges Dankeschön an Dich - das hätte ich selbst nicht hinbekommen. Ich schau gleich mal den Code durch und lerne :-)
vG
michax