SQLの窓

2017年08月06日


VBA : livedoor お天気API の JSON データを読み込んで利用する

InternetExplorer.Application 経由で JSON.parse を使用する方法 で、JSON 文字列をパースする方法は既にありますが、実用としてはプロパティを文字列段階で置換して、VB の予約語から排除する必要があります。その為に RegExp(VBScript.RegExp) を使用して _data をプロパティに付加します。

Sub ボタン1_Click()

    Dim objHttp As Object
    Dim strResult As String
    Dim objJSON As Object

    Dim lResolve As Long: lResolve = 60& * 1000
    Dim lConnect As Long: lConnect = 60& * 1000
    Dim lSend As Long: lSend = 60& * 1000
    Dim lReceive As Long: lReceive = 60& * 1000
    
    Set objHttp = CreateObject("Msxml2.ServerXMLHTTP")
    ' Livedoor のお天気情報(大阪)
    Call objHttp.Open("GET", "http://weather.livedoor.com/forecast/webservice/json/v1?city=270000", False)
    Call objHttp.setTimeouts(lResolve, lConnect, lSend, lReceive)
    Call objHttp.Send
    
    strResult = objHttp.responseText
    
    Set objReg = CreateObject("VBScript.RegExp")
    
    ' 全て置換
    objReg.Global = True
    ' パターン : () はサブマッチの範囲
    objReg.Pattern = """([^""]+)"":"
    
    ' $1 がサブマッチした文字列
    strResult = objReg.Replace(strResult, """$1_data""" & ":")
    
    Set objJSON = Parse(strResult)
    
    Set objHttp = Nothing
    
    MsgBox objJSON.title_data & " | " & objJSON.description_data.text_data

End Sub

Function Parse(json As String)

    Dim doc As Object, result As Object

    Set Ie = CreateObject("InternetExplorer.Application")
    Ie.Navigate ("about:blank")
    
    Do While Ie.Busy
        ' 100 ミリ秒
        Wscript.Sleep 100
    Loop
    
    Set doc = Ie.document
    
    doc.write "<script>document.JSON_Parse=function(s) {return JSON.parse(s);}</script>"
    
    Set Parse = doc.JSON_Parse(json)
    
    Ie.Quit
    
    Set Ie = Nothing

End Function






タグ:VBA VB EXCEL
posted by lightbox at 2017-08-06 00:13 | VBA | このブログの読者になる | 更新情報をチェックする
container 終わり



フリーフォントで簡単ロゴ作成
フリーフォントでボタン素材作成
フリーフォントで吹き出し画像作成
フリーフォントではんこ画像作成
ほぼ自由に利用できるフリーフォント
フリーフォントの書体見本とサンプル
画像を大きく見る為のウインドウを開くボタンの作成

CSS ドロップシャドウの参考デモ
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり