Symfoware

Symfowareについての考察blog

ExcelのVBAからデータをJSON形式に変換してPOSTを実行する

VBAからデータをPOSTする方法がわかりました。
ExcelのVBAからWebアプリケーションにPOSTを実行する

目標は、Excelに表示しているCellのデータをサーバーにPOSTし、
データベースへの登録を行うことです。

これまでの内容で、一行づつ登録を実行すれば目的は果たせるのですが、
せっかくなので、登録したい内容をJSON形式に変換し、
一撃でPOSTと登録を完了できるようにしてみます。



Excelのマクロ



JScriptで実装することにこだわりすぎたかもしれません。
というのも、JScriptの配列に入れておけば簡単にJSON形式の
文字列に変換できると思っていたのですが、そうはいきませんでした。

jscript_ハッシュ配列を文字列化
こちらを参考に、ArrayをJSON形式のオブジェクトに変換して登録を実行しています。

また、意外とJScriptで連想配列の作り方がわからずはまりました。
JScript の Object オブジェクト
・・・普通にObjectでよかったです。


データの検索や登録を含めたソースはこんな感じになりました。

■ボタンクリック処理

'検索ボタンクリック
Sub Search_Click()
    
    Dim row_count As Long
    Dim obj As JSON
    Set obj = GetJSON("")
    
    row_count = 6
    Do While obj.HasNext
        Sheet1.Cells(row_count, 1) = obj.GetValue("id")
        Sheet1.Cells(row_count, 2) = obj.GetValue("name")
        row_count = row_count + 1
    Loop
    
    Set obj = Nothing
    
End Sub

'クリアボタンクリック
Sub Clear_Click()
    
    Dim row_count As Long
    row_count = 6
    
    
    Do While True
        If Sheet1.Cells(row_count, 1) = "" Then
            Exit Do
        End If
    
        Sheet1.Cells(row_count, 1) = ""
        Sheet1.Cells(row_count, 2) = ""
        row_count = row_count + 1
        
    Loop
End Sub

'更新ボタンクリック
Sub Update_Click()
    Dim row_count As Long
    Dim obj As New JSON
    
    row_count = 6
    
    Do While True
        If Sheet1.Cells(row_count, 1) = "" Then
            Exit Do
        End If
        
        Call obj.NewRow
        Call obj.AddData("id", Sheet1.Cells(row_count, 1))
        Call obj.AddData("name", Sheet1.Cells(row_count, 2))
        row_count = row_count + 1
        
    Loop
    
    Call PostData("", "data", obj.Encode)
    
    MsgBox "登録しました"
End Sub




■データ取得・登録部分

'接続するURLのベース部分を指定
Private Const TARGET_URL As String = "http://www.example.com:8888/"

Public Function CreateHttpObject() As Object
    Dim objweb As Object
    
    '各種名称でHTTPオブジェクトの生成を試みる
    Err.Clear
    Set objweb = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    If Err.Number = 0 Then
        Set CreateHttpObject = objweb
        Exit Function
    End If
    
    
    Err.Clear
    Set objweb = CreateObject("MSXML2.ServerXMLHTTP")
    If Err.Number = 0 Then
        Set CreateHttpObject = objweb
        Exit Function
    End If

    
    Err.Clear
    Set objweb = CreateObject("MSXML2.XMLHTTP")
    If Err.Number = 0 Then
        Set CreateHttpObject = objweb
        Exit Function
    End If
    
    Set CreateHttpObject = Nothing

End Function

Public Function GetData(ByVal url As String) As String
    Dim objweb As Object
    
    'XMLHTTPオブジェクトを生成
    Set objweb = CreateHttpObject()
    
    'オブジェクトの生成に失敗していれば処理終了
    If objweb Is Nothing Then
        GetData = ""
        Exit Function
    End If
    
    objweb.Open "GET", TARGET_URL & url, False
    objweb.Send
    
    GetData = objweb.responseText
    
    Set objweb = Nothing
End Function

Public Function GetJSON(ByVal url As String) As JSON
    Dim data As String
    Dim obj As JSON
    
    data = GetData(url)
    
    If data = "" Then
        Set GetJSON = Nothing
        Exit Function
    End If
    
    Set obj = New JSON
    Call obj.Parse(data)
    
    Set GetJSON = obj
End Function

Public Function PostData(ByVal url As String, ByVal key As String, ByRef data As String) As String

    Dim call_data As Variant
    Dim objweb As Object
    
    'XMLHTTPオブジェクトを生成
    Set objweb = CreateHttpObject()
    
    'オブジェクトの生成に失敗していれば処理終了
    If objweb Is Nothing Then
        PostData = ""
        Exit Function
    End If
    
    call_data = key & "=" & data
    
    Call objweb.Open("POST", TARGET_URL & url, False)
    Call objweb.SetRequestHeader("Content-Type", "application/x-www-form-urlencoded")
    Call objweb.SetRequestHeader("Content-Length", Len(call_data))
    Call objweb.Send(call_data)
    
    PostData = objweb.responseText
    
    Set objweb = Nothing
End Function




■JSON周り

Private sc As Object
Private current_id As Long
Private max_id As Long

'コンストラクタ
Public Sub Class_Initialize()

    Dim code As String
    
    code = ""
    code = code & "function EncodeDataDetails(obj,str) {"
    code = code & " var result='';"
    code = code & " for (key in obj){"
    code = code & "     if (typeof obj[key] =='object'){"
    code = code & "         result += '{'+EncodeDataDetails( obj[key],str ) +'},';"
    code = code & "     } else {"
    code = code & "         result += '""' + key + '"": ""'+ obj[key] +'"",';"
    code = code & "     }"
    code = code & " }"
    code = code & " return result.slice(0,result.length-1);"
    code = code & "}"

    'コンストラクタで、JScriptオブジェクトを生成
    Set sc = CreateObject("ScriptControl")
    With sc
        .Language = "JScript"
        'スクリプト内で使用する変数を宣言
        .AddCode "var ary = new Array();"
        .AddCode "var row;"
        
        '指定したインデックス、名称のデータを取得する
        .AddCode "function GetValue(index, name) { return ary[index][name];}"
        
        '配列数取得用
        .AddCode "function GetLength() { return ary.length;}"
        
        'データ追加用
        '.AddCode "function NewRow() { row = {}; ary.append(row); }"
        .AddCode "function NewRow() { row = new Object(); ary[ary.length] = row; }"
        .AddCode "function AddData(key, value) { row[key] = value; }"
        .AddCode "function EncodeData() { return '[' + EncodeDataDetails(ary, '') + ']'; }"
        .AddCode code
    End With
    
    current_id = -1
    max_id = 0
End Sub

'JSON形式のデータを解析する
Public Sub Parse(ByRef data As String)
    'aryというオブジェクトに取得したJSON形式のデータを展開
    sc.AddCode "var ary = " & data & ";"
    
    '配列数を確定
    max_id = sc.CodeObject.GetLength("")
    
End Sub

'まだデータが存在するか
Public Function HasNext() As Boolean
    current_id = current_id + 1
    HasNext = (current_id < max_id)
End Function

'インデックスを指定してのデータ取得
Public Function GetValueAt(ByVal index As Long, ByVal id As String) As String
    GetValueAt = sc.CodeObject.GetValue(index, id)
End Function

'カレント行のデータ取得
Public Function GetValue(ByVal id As String) As String
    GetValue = GetValueAt(current_id, id)
End Function


'新しい行を宣言
Public Function NewRow()
    Call sc.CodeObject.NewRow("")
End Function

'データを行に追加
Public Function AddData(ByVal key As String, ByVal value As String)
    Call sc.CodeObject.AddData(key, value)
    'sc.Eval ("row.key = value;")
End Function

'JSON形式に変換
Public Function Encode() As String
    Encode = sc.CodeObject.EncodeData("")
End Function

'デストラクタ
Public Sub Class_Terminate()
    Set sc = Nothing
End Sub






サーバー側のロジック



データの取得や更新部分はTornadoで実装しています。
ソースはこんな感じです。


# -*- coding: utf-8 -*-

import os
import sqlite3
import json
import tornado.httpserver
import tornado.ioloop
import tornado.options
import tornado.web
import tornado.autoreload


from tornado.options import define, options

define("port", default=8888, help="run on the given port", type=int)
class Application(tornado.web.Application):
    def __init__(self):
        handlers = [
            (r"/", JSONHandler),
        ]
        settings = dict(
            template_path=os.path.join(os.path.dirname(__file__), "templates"),
            static_path=os.path.join(os.path.dirname(__file__), "static"),
        )
        tornado.web.Application.__init__(self, handlers, **settings)

        # Have one global connection to the blog DB across all handlers
        self.db = sqlite3.connect(r"C:\sample\test.db")


class JSONHandler(tornado.web.RequestHandler):
    @property
    def db(self):
        return self.application.db
    
    def get(self):
        
        data = []
        for row in self.db.execute("select id,name from master"):
            data.append({'id':row[0], 'name':row[1]})
        
        
        self.write(json.JSONEncoder().encode(data))

    def post(self):
        
        #Excel VBAからPOSTされたデータを取得
        data = self.get_argument('data')
        #デコード実行
        decoded = json.JSONDecoder().decode(data)
        
        #いったん削除(面倒なので・・・)
        self.db.execute("delete from master")
        for row in decoded:
            self.db.execute("insert into master (id, name) values (%s, '%s')" % (row['id'], row['name']))
            
        self.db.commit()
        self.write("ok")

def main():
    tornado.options.parse_command_line()
    http_server = tornado.httpserver.HTTPServer(Application())
    http_server.listen(options.port)
    tornado.ioloop.IOLoop.instance().start()

if __name__ == "__main__":
    main()







実行結果



09_001_20100917172753.png

09_002.png

09_003.png



これでマスタ登録の作成が楽になるかもです。



【参考URL】
jscript_ハッシュ配列を文字列化

JScript の Object オブジェクト













関連記事

テーマ:プログラミング - ジャンル:コンピュータ

  1. 2010/09/24(金) 12:26:59|
  2. 備忘録
  3. | トラックバック:0
  4. | コメント:0
  5. | 編集
次のページ