Kursabfrage funktioniert nur einmal
04.02.2023 18:46:13
Andreas
ich habe ein Problem, welches die VBA-Kursabfrage von Kryptowährungen von der BISON-Website mit Excel 2010 unter WIndows 10 betrifft.
Prinzipiell funktioniert der Code, allerdings nur beim ersten Durchlauf. Die korrekten Daten werden im Tabellenblatt 4 abgelegt. Die Kurswerte verändern sich alle paar Sekunden auf der Website, allerdings wird die Tabelle auf Tabellenblatt 4 ab dem 2. Durchlauf immer nur mit den Werten aus dem 1. Abruf "aktualisiert". Die Kurswerte verändern sich also nach dem 2. Durchlauf nicht mehr, obwohl auf der Website ganz andere Werte angezeigt werden.
Eingebunden in die Arbeitsmappe wurde der JsonConverter von T. Hall und die Bibliotheken Microsoft XML v6.0 und Microsoft Scripting Runtime.
Die Messageboxen dienten nur zur Prüfung und auch die versuchsweise Neutralisierung der Objekte "http" und "JSON" am Ende ändert nichts am Ergebnis des Codes....
Danke für eure Hilfe....
Andreas
Code "Diese Arbeitsmappe"
_________________________
Private Sub Workbook_Open()
Application.OnTime Now() + TimeValue("00:00:20"), "Kursabfrage"
End Sub
Code "Module"_____________
Sub Kursabfrage()
MsgBox "Start der Kursabfrage..."
Dim http As Object, JSON As Object, i As Integer
Set http = CreateObject("MSXML2.XMLHTTP")
MsgBox ("Daten werden von BISON-Website geholt...")
http.Open "GET", "https://bisonapp.com/ajax/read.php", False
http.send
Set JSON = ParseJson(http.responseText)
MsgBox ("Inhalt von http = " & http.responseText & " ....")
i = 2
For Each item In JSON
Sheets(4).Cells(i, 2).Value = item("baseEntity")
Sheets(4).Cells(i, 3).Value = item("price")
Sheets(4).Cells(i, 4).Value = item("buyPrice")
Sheets(4).Cells(i, 5).Value = item("sellPrice")
i = i + 1
Next
MsgBox ("Schleife wird verlassen - i = " & i)
Application.OnTime Now() + TimeValue("00:00:20"), "Kursabfrage"
Set http = Nothing
Set JSON = Nothing
End Sub