ビットコイン(bitFlyer)の過去チャートをExcelで取得

　 Excel　VBAの勉強のためJSONデータを取得してみようと思い立ち、何か面白いものはないかと探していました。最近何かと世間をにぎわせているbitCoinの過去チャートがJSONデータで公開さしているサイトがあることをここで見つけました。この記事を参照させてもらいbitFlyerの過去チャートをダウンロードするExcel マクロをVBAで作成してみました。

サンプル画像
ここで公開しています。


コード

Sub get_chart()
  '過去データの取得
  Dim targetURI
  Dim HttpReq
  Dim oXML
  Dim sc, objJSON, rcd
  Dim i As Integer
  
  targetURI = "https://min-api.cryptocompare.com/data/histohour?fsym=BTC&tsym=JPY&limit=2000&e=bitFlyer"
  Set HttpReq = CreateObject("MSXML2.XMLHTTP")
  HttpReq.Open "GET", targetURI, False
  HttpReq.send (Null)
  
  Dim restext As String
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", targetURI, False
    .send
    Set oXML = .responseXML
    restext = .responseText
  End With

  Set sc = CreateObject("ScriptControl")
  sc.Language = "JScript"
  sc.AddCode "function jsonParse(s) { return eval('(' + s + ')'); }"
  Set objJSON = sc.CodeObject.jsonParse(restext)
  
  i = 5 'データ先頭行
  For Each rcd In objJSON.Data
    Cells(i, 1) = (CallByName(rcd, "time", VbGet) + 32400) / 86400 + 25569
    Cells(i, 2) = CallByName(rcd, "open", VbGet)
    Cells(i, 3) = CallByName(rcd, "close", VbGet)
    Cells(i, 4) = rcd.high
    Cells(i, 5) = rcd.low
    Cells(i, 6) = rcd.volumefrom
    Cells(i, 7) = rcd.volumeto
    i = i + 1
  Next
End Sub

Sub get_rate()
  '現在のレート
  Dim targetURI
  Dim HttpReq
  Dim oXML
  Dim sc, objJSON, rcd

  targetURI = "https://api.bitflyer.jp/v1/ticker?product_code=BTC_JPY"
  Set HttpReq = CreateObject("MSXML2.XMLHTTP")
  HttpReq.Open "GET", targetURI, False
  HttpReq.send (Null)

  Dim restext As String
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", targetURI, False
    .send
    Set oXML = .responseXML
    restext = .responseText
  End With

  Set sc = CreateObject("ScriptControl")
  sc.Language = "JScript"
  sc.AddCode "function jsonParse(s) { return eval('(' + s + ')'); }"
  Set objJSON = sc.CodeObject.jsonParse(restext)
  
    Cells(3, 4) = objJSON.timestamp
    Cells(3, 7) = objJSON.ltp
    Cells(3, 8) = objJSON.best_bid
    Cells(3, 9) = objJSON.best_ask
End Sub