Json API Abfrage - in eine Excel Tabelle schreiben

  • VBScript

    Json API Abfrage - in eine Excel Tabelle schreiben

    Hallo liebe Forums-Mitglieder,

    ich bin neu hier und habe direkt eine Frage, bzw Problemstellung.

    Ich möchte von der Binance Api den Preis für eine Paarung abfragen und in einer Excel Tabelle ausgeben. Die Paarung(Symbol) wird in Zelle A1 der Excel Datei eingetragen und Der passende Preis soll in Zelle B1 ausgegeben werden. Mei Script läuft, ohne einen Fehler zu melden, tut jedoch nicht dass, was ich von Ihm will. Mein Tel beginnt bei Zeile 323. Den Rest habe ich von: gist.github.com/douglascrp/26477fa0c523186b55705890a97b9821 und sollte so funktionieren.
    Es wäre schön, wenn sich das mal jemand anschauen könnte...

    Spoiler anzeigen

    Quellcode

    1. Class VbsJson
    2.     ' Author: Demon
    3.     ' Date: 2012/5/3
    4.     ' Website: http://demon.tw/my-work/vbs-json.html
    5.     Private Whitespace, NumberRegex, StringChunk
    6.     Private b, f, r, n, t
    8.     Private Sub Class_Initialize
    9.         Whitespace = " " & vbTab & vbCr & vbLf
    10.         b = ChrW(8)
    11.         f = vbFormFeed
    12.         r = vbCr
    13.         n = vbLf
    14.         t = vbTab
    16.         Set NumberRegex = New RegExp
    17.         NumberRegex.Pattern = "(-?(?:0|[1-9]\d*))(\.\d+)?([eE][-+]?\d+)?"
    18.         NumberRegex.Global = False
    19.         NumberRegex.MultiLine = True
    20.         NumberRegex.IgnoreCase = True
    22.         Set StringChunk = New RegExp
    23.         StringChunk.Pattern = "([\s\S]*?)([""\\\x00-\x1f])"
    24.         StringChunk.Global = False
    25.         StringChunk.MultiLine = True
    26.         StringChunk.IgnoreCase = True
    27.     End Sub
    29.     ' Return a JSON string representation of a VBScript data structure
    30.     ' Supports the following objects and types
    31.     ' +-------------------+---------------+
    32.     ' | VBScript          | JSON          |
    33.     ' +===================+===============+
    34.     ' | Dictionary        | object        |
    35.     ' | Array             | array         |
    36.     ' | String            | string        |
    37.     ' | Number            | number        |
    38.     ' | True              | true          |
    39.     ' | False             | false         |
    40.     ' | Null              | null          |
    41.     ' +-------------------+---------------+
    42.     Public Function Encode(ByRef obj)
    43.         Dim buf, i, c, g
    44.         Set buf = CreateObject("Scripting.Dictionary")
    45.         Select Case VarType(obj)
    46.             Case vbNull
    47.                 buf.Add buf.Count, "null"
    48.             Case vbBoolean
    49.                 If obj Then
    50.                     buf.Add buf.Count, "true"
    51.                 Else
    52.                     buf.Add buf.Count, "false"
    53.                 End If
    54.             Case vbInteger, vbLong, vbSingle, vbDouble
    55.                 buf.Add buf.Count, obj
    56.             Case vbString
    57.                 buf.Add buf.Count, """"
    58.                 For i = 1 To Len(obj)
    59.                     c = Mid(obj, i, 1)
    60.                     Select Case c
    61.                         Case """" buf.Add buf.Count, "\"""
    62.                         Case "\"  buf.Add buf.Count, "\\"
    63.                         Case "/"  buf.Add buf.Count, "/"
    64.                         Case b    buf.Add buf.Count, "\b"
    65.                         Case f    buf.Add buf.Count, "\f"
    66.                         Case r    buf.Add buf.Count, "\r"
    67.                         Case n    buf.Add buf.Count, "\n"
    68.                         Case t    buf.Add buf.Count, "\t"
    69.                         Case Else
    70.                             If AscW(c) >= 0 And AscW(c) <= 31 Then
    71.                                 c = Right("0" & Hex(AscW(c)), 2)
    72.                                 buf.Add buf.Count, "\u00" & c
    73.                             Else
    74.                                 buf.Add buf.Count, c
    75.                             End If
    76.                     End Select
    77.                 Next
    78.                 buf.Add buf.Count, """"
    79.             Case vbArray + vbVariant
    80.                 g = True
    81.                 buf.Add buf.Count, "["
    82.                 For Each i In obj
    83.                     If g Then g = False Else buf.Add buf.Count, ","
    84.                     buf.Add buf.Count, Encode(i)
    85.                 Next
    86.                 buf.Add buf.Count, "]"
    87.             Case vbObject
    88.                 If TypeName(obj) = "Dictionary" Then
    89.                     g = True
    90.                     buf.Add buf.Count, "{"
    91.                     For Each i In obj
    92.                         If g Then g = False Else buf.Add buf.Count, ","
    93.                         buf.Add buf.Count, """" & i & """" & ":" & Encode(obj(i))
    94.                     Next
    95.                     buf.Add buf.Count, "}"
    96.                 Else
    97.                     Err.Raise 8732,,"None dictionary object"
    98.                 End If
    99.             Case Else
    100.                 buf.Add buf.Count, """" & CStr(obj) & """"
    101.         End Select
    102.         Encode = Join(buf.Items, "")
    103.     End Function
    105.     ' Return the VBScript representation of ``str(``
    106.     ' Performs the following translations in decoding
    107.     ' +---------------+-------------------+
    108.     ' | JSON          | VBScript          |
    109.     ' +===============+===================+
    110.     ' | object        | Dictionary        |
    111.     ' | array         | Array             |
    112.     ' | string        | String            |
    113.     ' | number        | Double            |
    114.     ' | true          | True              |
    115.     ' | false         | False             |
    116.     ' | null          | Null              |
    117.     ' +---------------+-------------------+
    118.     Public Function Decode(ByRef str)
    119.         Dim idx
    120.         idx = SkipWhitespace(str, 1)
    122.         If Mid(str, idx, 1) = "{" Then
    123.             Set Decode = ScanOnce(str, 1)
    124.         Else
    125.             Decode = ScanOnce(str, 1)
    126.         End If
    127.     End Function
    129.     Private Function ScanOnce(ByRef str, ByRef idx)
    130.         Dim c, ms
    132.         idx = SkipWhitespace(str, idx)
    133.         c = Mid(str, idx, 1)
    135.         If c = "{" Then
    136.             idx = idx + 1
    137.             Set ScanOnce = ParseObject(str, idx)
    138.             Exit Function
    139.         ElseIf c = "[" Then
    140.             idx = idx + 1
    141.             ScanOnce = ParseArray(str, idx)
    142.             Exit Function
    143.         ElseIf c = """" Then
    144.             idx = idx + 1
    145.             ScanOnce = ParseString(str, idx)
    146.             Exit Function
    147.         ElseIf c = "n" And StrComp("null", Mid(str, idx, 4)) = 0 Then
    148.             idx = idx + 4
    149.             ScanOnce = Null
    150.             Exit Function
    151.         ElseIf c = "t" And StrComp("true", Mid(str, idx, 4)) = 0 Then
    152.             idx = idx + 4
    153.             ScanOnce = True
    154.             Exit Function
    155.         ElseIf c = "f" And StrComp("false", Mid(str, idx, 5)) = 0 Then
    156.             idx = idx + 5
    157.             ScanOnce = False
    158.             Exit Function
    159.         End If
    161.         Set ms = NumberRegex.Execute(Mid(str, idx))
    162.         If ms.Count = 1 Then
    163.             idx = idx + ms(0).Length
    164.             ScanOnce = CDbl(ms(0))
    165.             Exit Function
    166.         End If
    168.         Err.Raise 8732,,"No JSON object could be ScanOnced"
    169.     End Function
    171.     Private Function ParseObject(ByRef str, ByRef idx)
    172.         Dim c, key, value
    173.         Set ParseObject = CreateObject("Scripting.Dictionary")
    174.         idx = SkipWhitespace(str, idx)
    175.         c = Mid(str, idx, 1)
    177.         If c = "}" Then
    178.             Exit Function
    179.         ElseIf c <> """" Then
    180.             Err.Raise 8732,,"Expecting property name"
    181.         End If
    183.         idx = idx + 1
    185.         Do
    186.             key = ParseString(str, idx)
    188.             idx = SkipWhitespace(str, idx)
    189.             If Mid(str, idx, 1) <> ":" Then
    190.                 Err.Raise 8732,,"Expecting : delimiter"
    191.             End If
    193.             idx = SkipWhitespace(str, idx + 1)
    194.             If Mid(str, idx, 1) = "{" Then
    195.                 Set value = ScanOnce(str, idx)
    196.             Else
    197.                 value = ScanOnce(str, idx)
    198.             End If
    199.             ParseObject.Add key, value
    201.             idx = SkipWhitespace(str, idx)
    202.             c = Mid(str, idx, 1)
    203.             If c = "}" Then
    204.                 Exit Do
    205.             ElseIf c <> "," Then
    206.                 Err.Raise 8732,,"Expecting , delimiter. Got " & c & " at " & idx
    207.             End If
    209.             idx = SkipWhitespace(str, idx + 1)
    210.             c = Mid(str, idx, 1)
    211.             If c <> """" Then
    212.                 Err.Raise 8732,,"Expecting property name"
    213.             End If
    215.             idx = idx + 1
    216.         Loop
    218.         idx = idx + 1
    219.     End Function
    221.     Private Function ParseArray(ByRef str, ByRef idx)
    222.         Dim c, values, value
    223.         Set values = CreateObject("Scripting.Dictionary")
    224.         idx = SkipWhitespace(str, idx)
    225.         c = Mid(str, idx, 1)
    227.         If c = "]" Then
    228.             idx = idx + 1
    229.             ParseArray = values.Items
    230.             Exit Function
    231.         End If
    233.         Do
    234.             idx = SkipWhitespace(str, idx)
    235.             If Mid(str, idx, 1) = "{" Then
    236.                 Set value = ScanOnce(str, idx)
    237.             Else
    238.                 value = ScanOnce(str, idx)
    239.             End If
    240.             values.Add values.Count, value
    242.             idx = SkipWhitespace(str, idx)
    243.             c = Mid(str, idx, 1)
    244.             If c = "]" Then
    245.                 Exit Do
    246.             ElseIf c <> "," Then
    247.                 Err.Raise 8732,,"Expecting , delimiter"
    248.             End If
    250.             idx = idx + 1
    251.         Loop
    253.         idx = idx + 1
    254.         ParseArray = values.Items
    255.     End Function
    257.     Private Function ParseString(ByRef str, ByRef idx)
    258.         Dim chunks, content, terminator, ms, esc, char
    259.         Set chunks = CreateObject("Scripting.Dictionary")
    261.         Do
    262.             Set ms = StringChunk.Execute(Mid(str, idx))
    263.             If ms.Count = 0 Then
    264.                 Err.Raise 8732,,"Unterminated string starting"
    265.             End If
    267.             content = ms(0).Submatches(0)
    268.             terminator = ms(0).Submatches(1)
    269.             If Len(content) > 0 Then
    270.                 chunks.Add chunks.Count, content
    271.             End If
    273.             idx = idx + ms(0).Length
    275.             If terminator = """" Then
    276.                 Exit Do
    277.             ElseIf terminator <> "\" Then
    278.                 Err.Raise 8732,,"Invalid control character"
    279.             End If
    281.             esc = Mid(str, idx, 1)
    283.             If esc <> "u" Then
    284.                 Select Case esc
    285.                     Case """" char = """"
    286.                     Case "\"  char = "\"
    287.                     Case "/"  char = "/"
    288.                     Case "b"  char = b
    289.                     Case "f"  char = f
    290.                     Case "n"  char = n
    291.                     Case "r"  char = r
    292.                     Case "t"  char = t
    293.                     Case Else Err.Raise 8732,,"Invalid escape"
    294.                 End Select
    295.                 idx = idx + 1
    296.             Else
    297.                 char = ChrW("&H" & Mid(str, idx + 1, 4))
    298.                 idx = idx + 5
    299.             End If
    301.             chunks.Add chunks.Count, char
    302.         Loop
    304.         ParseString = Join(chunks.Items, "")
    305.     End Function
    307.     Private Function SkipWhitespace(ByRef str, ByVal idx)
    308.         Do While idx <= Len(str) And _
    309.             InStr(Whitespace, Mid(str, idx, 1)) > 0
    310.             idx = idx + 1
    311.         Loop
    312.         SkipWhitespace = idx
    313.     End Function
    315. End Class
    317.      
    318.      
    320. '_____________________________________________________________
    321.  
    322.  Dim fso, json, str, o, i
    323.      Set json = New VbsJson
    324.      Set fso = WScript. CreateObject ( "Scripting.Filesystemobject" )
    325.      Str = fso.OpenTextFile( "json.txt" ).ReadAll
    326.      Set o = json.Decode(str)
    328. Set http = CreateObject("MSXML2.XMLHTTP")
    329. http.Open "GET", "https://api.binance.com/api/v3/ticker/price", False
    330. On Error Resume Next
    331. http.Send
    332. 'On Error GoTo error
    333. Set JSON = ParseJson(http.ResponseText)
    335. Set ExcelApp = CreateObject("Excel.Application")
    336. Set MyBook = ExcelApp.Workbooks.Open("C:\Users\wir\Desktop\cb\VBscript\1.xlsm")
    337. Set MySheet = MyBook.Worksheets("Sheet1")
    339. For Each Item In JSON
    340.     If Item("symbol") = MySheet.Range("A1").Value And MySheet.Range("A1").Value <> "" Then
    341.     MySheet.Range("B1").Value = Item("price")
    342.     End If
    343.    
    344. Next


    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

Facebook
Telefonspende