[orca-tech:01878] 【ＶＢＡ】

[koji yuen <koji.yuen@xxxxxxxxx>]

エクセルからOrcaのAPIを利用するVBAプログラムをつくってみました

今回は受付取得のPOSTメソッドによるプログラムです。

Orcaへのリクエストはxmlファイルでおこない
Orcaからのレスポンスはxmlファイルに保存するようにしてあります。
Windowsは文字コードがShiftJISであり、Orcaのxmlファイルはutf-8なので、
ADODB.Streamを使った文字変換をおこなっています。

レスポンスを読み込んでxmlを自前のVBAプログラムで処理も可能ですが,
やはりエクセルのxml読み書き機能を使ってxmlファイルを処理するのが王道と考えまし
た。

バグやプログラムに対するアドバイスお聞かせください。
Excel2010で動きます。

なおプログラムは、すず工房さんのＨＰを参考にさせていただきました。
http://it-doc.jp/index.php/excelforwork/vba/181-get-html

ゆうえん医院＠岡山

----------------------------------------------------------------------

Sub post_orca_api(API As String, xml_file As String, RequestStr As String)

'要求されたAPIにPOSTリクエストする

    Dim Http As Object
    Dim inStrm As Object

    Dim URL As String
    Dim HOST As String
    Dim PORT As String
    Dim USER As String
    Dim PASSWD As String

    HOST = "192.168.0.1"	'OrcaサーバーのIPアドレス
    PORT = "8000"
    USER = "ormaster"
    PASSWD = "ormaster123"

    URL = "http://"; & HOST & ":" & PORT & API

    Set Http = CreateObject("MSXML2.XMLHTTP")

    Http.Open "POST", URL, False, USER, PASSWD

    Http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
    'false:同期通信

    '要求を送信 パラメーターも送信
    Http.send (RequestStr)

    If Http.Status = 200 Then '同期通信のチェック

        Set inStrm = CreateObject("ADODB.Stream")
        With inStrm
            .Open
            .Position = 0
            .Type = 1 'TypeBinary　　バイナリのまま
            .Write Http.responseBody 'streamに書き込む

            .Position = 0
            .Type = 2 'TypeText　テキストで読みだす
            .Charset = "UTF-8"
                    'stream から読み取られるデータを指定文字エンコードに変換
            .SaveToFile xml_file, 2
                    '指定されたファイルに書き込む

            .Close
        End With
        

        Set inStrm = Nothing
    End If

 Set Http = Nothing

End Sub

------------------------------------------------------------

Sub orca_acceptlstv2(RequestStr As String)

'受付情報の取得API

    Dim api_command As String
    Dim out_file As String
    
    api_command = "/api01rv2/acceptlstv2?class=01"　'受付中の情報取得
    out_file = "C:\ORCA\acceptlstv2_ans.xml" 'レスポンスのxmlファイル

    post_orca_api api_command, out_file, RequestStr

End Sub

------------------------------------------------------------

Sub acceptlstv2()

'受付情報の取得

    Dim RequestStr As String
    Dim req_file As String
    
    req_file = "C:\ORCA\acceptlstv2_req.xml"　'POSTリクエストのxmlファイル
    
    
        Set ReqStrm = CreateObject("ADODB.Stream")
        With ReqStrm
            .Open
            .Position = 0
            .Type = 2 'TypeText　テキストで書き込む
            .Charset = "UTF-8"
            .LoadFromFile req_file 'ファイルからstreamに書き込む

            .Position = 0
            .Type = 2 'TypeText　テキストで読みだす
            .Charset = "UTF-8"  'stream から読み取るデータを指定文字エンコード
に変換
            RequestStr = .ReadText  '文字列にテキストで読み出す
            .Close
        End With

    orca_acceptlstv2 RequestStr
    
End Sub