2012年9月30日日曜日

ExcelでJsonデータを取得する

どうにかエクセルでjsonデータを取得できないか考えて、いろいろ探しましたが、ScriptControlを使うものしか見つからなかったので、コロンブスの卵的な発想でVBAでIEのHTMLDocumentオブジェクトを作ってその内部でJavaScriptに処理してもらった後、結果をもらうことにしてみました。 以下コード。
Option Explicit

'Microsoft WinHTTP Services, version 5.1 に参照設定

'WinHttpRequest proxy settings.
Const HTTPREQUEST_PROXYSETTING_DEFAULT = 0
Const HTTPREQUEST_PROXYSETTING_PRECONFIG = 0
Const HTTPREQUEST_PROXYSETTING_DIRECT = 1
Const HTTPREQUEST_PROXYSETTING_PROXY = 2
'Specifies when IWinHttpRequest uses credentials. Can be one of the following values.
Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = &H0
Const HTTPREQUEST_SETCREDENTIALS_FOR_PROXY = &H1


Sub tweet_search_json()
  Dim req As New WinHttp.WinHttpRequest
  Dim js As String
  Dim doc As Object
  Dim obj As Object
  
  req.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 "
  req.Open "GET", "http://search.twitter.com/search.json?q=okinawa", False
  req.Send
  
  'JavaScript
  js = "json = (<<json_response>>);" & _
       "for( var i in json.results){ " & _
           "var elm = document.createElement('div');" & _
           "elm.innerHTML = json.results[i].text;" & _
           "document.getElementsByTagName('body').item(0).appendChild(elm);" & _
       "}"
  
  'IEの HTMLDocument オブジェクトを作る
  Set doc = CreateObject("htmlfile")
  
  ' スクリプト実行
  doc.parentWindow.execScript Replace(js, "<<json_response>>", req.ResponseText), "JavaScript"
  For Each obj In doc.getElementsByTagName("div")
    Debug.Print obj.FirstChild.nodevalue
  Next
  
  Set req = Nothing
  Set doc = Nothing
  Set obj = Nothing
End Sub


「Microsoft WinHTTP」が必要です。(おそらくWin2000以降はインストールされているはず)