none
excel vba api connection can someone see where the error comes from ? RRS feed

  • Question

  • Hi all,

    I try to make a connection with api to a website.

    The info for the api code is here :  https://www.binance.com/restapipub.html

    my code (I am not an expert, just put some things together, not sure all needed or correct)

    I get a json error 10001 in parsejson (jasonconveter)

    and in the table I get 404 http not found :-(

    Thanks for help me out

    Chris

    Function PublicBinance(Method As String, Optional MethodOptions As String) As String Dim Url As String PublicApiSite = "https://api.binance.com" urlPathPub = "/api/v1/" & Method & "/" & MethodOptions Url = PublicApiSite & urlPathPub PublicBinance = GetDataFromURL(Url, "GET") End Function Function PrivateBinance(Method As String, apikey As String, secretkey As String, Optional MethodOptions As String) As String 'https://www.binance.com/restapipub.html Dim NonceUnique As String Dim postdata As String Dim Url As String 'Get a 10-digit Nonce NonceUnique = DateDiff("s", "1/1/1970", Now) TradeApiSite = "https://api.binance.com" urlPath = "/api/v3/" Url = TradeApiSite & urlPath & Method 'UrlEnc = LCase(URLEncode(Url)) postdata = "method=" & Method & MethodOptions & "&nonce=" & NonceUnique

    ' not sure 4 lines below is needed postdataJsonTxt = Replace(postdata, "=", Chr(34) & ":" & Chr(34)) postdataJsonTxt = Replace(postdataJsonTxt, "&", Chr(34) & "," & Chr(34)) postdataJsonTxt = "{" & Chr(34) & postdataJsonTxt & Chr(34) & "}" req64 = ComputeHash_C("MD5", postdataJsonTxt, "", "STR64") APIsign = ComputeHash_C("SHA512", postdata, secretkey, "STRHEX") ' Instantiate a WinHttpRequest object and open it Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") objHTTP.Open "POST", Url, False objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" objHTTP.setRequestHeader "X-MBX-APIKEY", postdata ' ‘API-KEY objHTTP.setRequestHeader "X-MBX-APIKEY", APIsign '‘SIGNED objHTTP.Send (postdata) objHTTP.WaitForResponse PrivateBinance = objHTTP.ResponseText Set objHTTP = Nothing End Function

    Sub GetMyBinanceData() Dim JsonResponse As String Dim Json As Dictionary Dim JsonRes As Dictionary Dim apikey As String Dim secretkey As String Set Sht = Worksheets("Binance") Set Tblpric = Sht.ListObjects("Tbl_Binance_Prices") Set TblTrad = Sht.ListObjects("Tbl_Binance_Trades") apikey = Sht.Range("apikey_Binance").Value secretkey = Sht.Range("secretkey_Binance").Value 'Unix time period: t1 = DateToUnixTime("1/1/2014") 'included t2 = DateToUnixTime("1/1/2018") 'excluded 'PublicBinance ticker Debug.Print PublicBinance("ticker", "/24h") JsonResponse = PublicBinance("ticker", "24h") Set Json = JsonConverter.ParseJson(JsonResponse) ResArr = JsonToArray(Json) Sht.Range("R6").Resize(UBound(ResArr, 2), UBound(ResArr, 1)) = WorksheetFunction.Transpose(ResArr) Tbl = ArrayTable(ResArr) Sht.Range("R6").Resize(UBound(Tbl, 2), UBound(Tbl, 1)) = WorksheetFunction.Transpose(Tbl) 'Put all data in a table If Not Tblpric.DataBodyRange Is Nothing Then Tblpric.DataBodyRange.End(xlDown).Resize(UBound(Tbl, 2), UBound(Tbl, 1)) = WorksheetFunction.Transpose(Tbl) Else Tblpric.InsertRowRange.Resize(UBound(Tbl, 2), UBound(Tbl, 1)) = WorksheetFunction.Transpose(Tbl) End If 'Remove header row if present If Not Tblpric.DataBodyRange Is Nothing Then Tblpric.ListRows(1).Delete End If 'PrivateBinance TradeHistory 'Empty result table If Not TblTrad.DataBodyRange Is Nothing Then TblTrad.DataBodyRange.Delete End If JsonResponse = PrivateBinance("openOrders", apikey, secretkey) Set Json = JsonConverter.ParseJson(JsonResponse) ResArr = JsonToArray(Json) Tbl = ArrayTable(ResArr) 'Put all data in a table If Not TblTrad.DataBodyRange Is Nothing Then TblTrad.DataBodyRange.End(xlDown).Resize(UBound(Tbl, 2), UBound(Tbl, 1)) = WorksheetFunction.Transpose(Tbl) Else TblTrad.InsertRowRange.Resize(UBound(Tbl, 2), UBound(Tbl, 1)) = WorksheetFunction.Transpose(Tbl) End If 'Remove header row if present If Not TblTrad.DataBodyRange Is Nothing Then TblTrad.ListRows(1).Delete End If End Sub


    • Edited by Incobart Monday, December 18, 2017 6:38 AM
    Monday, December 18, 2017 6:18 AM

All replies

  • Hi,

    Do you have the excel file or link and I'll have a look. doing same for my portfolio

    Thanks

    Denis

    Friday, January 5, 2018 10:12 PM