VBA-JSON Werte aus zellen einfügen

Hallo,
ich bastle seit geraumer Zeit an einem Exceldokument herum, in dem ich verschiedene API's abfragen möchte, um sie miteinander zu verknüpfen und auszuwerten.
nun bin ich an einem Punkt angelangt, an dem ich nicht weiterkomme. ich möchte von https://api.coincap.io/v2/candles?exchange=poloniex&interval=h1&baseId=ethereum&quoteId=bitcoin&start=1649894400000&end=1649898000000 den Wert "volume" in aufeinanderfolgenden Zellen ausgeben lassen. Das funktioniert auch schon gut. Allerdings möchte ich die Parameter für die Abfrage aus einer Zelle beziehen und da harpert es bei mir. Vermutlich ist es nur eine Kleinigkeit aber ich komme selber einfach nicht weiter. Mein code sieht folgendermaßen aus:


Sub GetVolume()
On Error Resume Next
'List of all symbols
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://api.coincap.io/v2/candles", False
On Error Resume Next
http.Send
Set json = ParseJson(http.ResponseText)
i = 10
For Each item In json("data")
If item("exchange") = Workbooks(1).Worksheets("Tabelle1").Range("A1").Value And Workbooks(1).Worksheets("Tabelle1").Range("A1").Value  "" Then
Sheets(1).Cells(1, i).Value = item("volume")
i = i + 1
End If
Next
Exit Sub
error:
End Sub

Die Parameter sollen also aus der Zelle A1 genommen werden und die Antwort in J1 und folgenden ausgegeben werden. Die Werte in A1 kommen dann später aus verschiedenen Zellen und sind mit Excel Funktionen zusammengesetzt.
Der Link zu meiner Excel-Datei lautet: https://www.herber.de/bbs/user/157048.xlsm
für jeden Tip bin ich dankbar.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub GetVolume() On Error Resume Next 'List of all symbols Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://api.coincap.io/v2/candles", False http.Send Set json = ParseJson(http.ResponseText) With Workbooks(1).Worksheets("Tabelle1") i = 10 If .Range("A1").Value "" Then For Each Item In json("data") If Item("exchange") = .Range("A1").Value Then .Cells(1, i).Value = Item("volume") i = i + 1 End If Next End If End With Exit Sub error: End Sub

Sub GetPrice() On Error Resume Next 'List of all prices Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://api.binance.com/api/v3/ticker/price", False http.Send Set json = ParseJson(http.ResponseText) With Workbooks(1).Worksheets("Tabelle1") i = 10 If .Range("A1").Value "" Then For Each item In json If item("symbol") = .Range("A1").Value Then .Cells(1, i).Value = item("price") i = i + 1 End If Next End If End With Exit Sub error: End Sub

Sub GetVolume() Dim objHTTP As Object, lngZeile As Long, strAntwort As String Set objHTTP = CreateObject("MSXML2.XMLHTTP") With ThisWorkbook.Worksheets("Tabelle1") For lngZeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row objHTTP.Open "GET", "https://api.coincap.io/v2/candles?exchange=" & .Cells(lngZeile, 1), False objHTTP.Send strAntwort = objHTTP.ResponseText If InStr(strAntwort, "volume") Then strAntwort = Mid(strAntwort, InStr(strAntwort, "volume") + 9, 999) strAntwort = Left(strAntwort, InStr(strAntwort, """") - 1) .Cells(lngZeile, 2) = strAntwort Else .Cells(lngZeile, 2) = "Server antwortet nicht" End If Next lngZeile End With End Sub

Sub GetVolume() Dim objHTTP As Object, lngZeile As Long, strAntwort As String Set objHTTP = CreateObject("MSXML2.XMLHTTP") With ThisWorkbook.Worksheets("Tabelle1") For lngZeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row objHTTP.Open "GET", "https://api.coincap.io/v2/candles?exchange=" & .Cells(lngZeile, 1), False objHTTP.Send i = 2 strAntwort = objHTTP.ResponseText If InStr(strAntwort, "volume") Then strAntwort = Mid(strAntwort, InStr(strAntwort, "volume") + 9, 999) strAntwort = Left(strAntwort, InStr(strAntwort, """") - 1) .Cells(lngZeile, i) = strAntwort i = i + 1 Else .Cells(lngZeile, i) = "Server antwortet nicht" End If Next lngZeile End With End Sub

Sub GetVolume() Dim objHTTP As Object, lngZeile As Long, strAntwort As String, varSplit As Variant, i As Integer Set objHTTP = CreateObject("MSXML2.XMLHTTP") With ThisWorkbook.Worksheets("Tabelle1") For lngZeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row objHTTP.Open "GET", "https://api.coincap.io/v2/candles?exchange=" & .Cells(lngZeile, 1), False objHTTP.Send strAntwort = objHTTP.ResponseText If InStr(strAntwort, "volume") Then varSplit = Split(strAntwort, "volume"":""") For i = 1 To UBound(varSplit) .Cells(lngZeile, i + 1) = Left(varSplit(i), InStr(varSplit(i), """") - 1) Next i Else .Cells(lngZeile, 2) = "Server antwortet nicht" End If Next lngZeile End With End Sub

Beliebteste Forumthreads (12 Monate)

VBA-JSON Werte aus zellen einfügen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA-JSON Werte aus zellen einfügen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread