デジタルサイネージ編の第5回です。
今回はPowoerPointのVBA部分について説明します。
機能／手順の確認
いきなりコーディングに入る前にやる事の確認をします。
・個人情報の収集(スケジュール取得にはUSIDが必要です)
・スケジュール情報の収集
となります。
今回のWEB APIは応答メッセージにXML形式の文書を返すため、VBAによるデータの受け口を「MSXML2.DOMDocument」にて行います。また、通信はHTTPを介して行うため「MSXML2.ServerXMLHTTP」を利用します。
手順は以下のようになります。
・MSXML2.ServerXMLHTTPにサーバーや通信条件を指定します。
・MSXML2.ServerXMLHTTPでリクエストURLを送信します。
・MSXML2.ServerXMLHTTPで受信したデータをMSXML2.DOMDocumentに引き渡します。
・MSXML2.DOMDocumentでXML解析を行います。
個人情報、スケジュール情報の両方にて上記手順を踏みます。
XML解析の準備
MSXML2.DOMDocumentを利用するとXML文書の解析がかなり楽になります。
MSXML2.DOMDocumentには沢山の情報がありますが、今回利用する項目のみ説明します。
MSXML2.DOMDocument
XML文書はざっくり言うなればタグで囲まれた情報体の集合です(厳密には異なります)。今回欲しい情報はタグの名前、タグに含まれる情報、そしてタグの階層です。
- nodeName
- nodeTypedValue
- childNodes
現在指しているタグの名称です。<Usid>～</Usid>に囲まれている区間のnodeNameはUsidになります。
現在指しているタグに有効な情報がある場合、nodeValueに表示されます。GroupSessionのユーザーSID(USID)やスケジュール内容(Naiyo)を抽出する際に参照します。
タグがネスト(タグの中にタグがある。階層化)されているとき、どのようなタグが存在するか一覧が表示されます。WEB APIのレスポンスが以下のような形式で送られてくるので
<ResultSet>
<Result>
<Usid>100</Usid>
～
</Result>
</ResultSet>
VBA上では
Item1
├ nodeName：ResultSet
├ nodeTypedValue：(null)
└ childNode
└ Item1
├ nodeName：Result
├ nodeTypedValue：(null)
└ childNode
├ Item1
│ ├ nodeName：Usid
│ ├ nodeTypedValue：100
│ └ childNode：(Nothing)
├ Item2
～
のように階層化されて見えるようになります。
今回は下位階層を得る関数(get_childTAG)と同列階層から目的タグを得る関数(get_TAG)を用意しました。
関数内でnodeと呼んでいるのはタグで囲まれた区間の情報だと思ってください。
'_/
'_/ XML子ノードの取得
'_/
Private Function get_childTAG(objNode, strName As String)
Dim obj As Object
Set get_childTAG = Nothing ' 戻り値を初期化
If Not objNode Is Nothing Then ' 有効なnode指示なら
For Each obj In objNode ' 最終nodeまで
If obj.nodeName Like strName Then ' 名称が一致したら
Set get_childTAG = obj.ChildNodes ' 子nodeを返す
Exit For
End If
Next obj
End If
End Function
'_/
'_/ XML適応ノードの取得
'_/
Private Function get_TAG(objNode, strName As String)
Dim obj As Object
Set get_TAG = Nothing ' 戻り値を初期化
If Not objNode Is Nothing Then ' 有効なnode指示なら
For Each obj In objNode ' 最終nodeまで
If obj.nodeName Like strName Then ' 名称が一致したら
Set get_TAG = obj ' 自nodeを返す
Exit For
End If
Next obj
End If
End Function
個人情報の入手
GroupSesson WEB APIに対して個人情報の入手リクエストを行います。
'_/
'_/ GroupSessionユーザー情報の取得
'_/
Private Function get_USID_Info(strUName, strUPass)
Dim url As String
Dim objDomDoc As MSXML2.DOMDocument
Dim objXmlHttp As MSXML2.ServerXMLHTTP
Dim adoStrm As New ADODB.Stream
Dim obj, objs, objsub, objKey, arrx, arry As Object
Dim str As String
url = "http://" & SEVER_IP & "/gsession/api/user/search.do?"
Set objXmlHttp = New MSXML2.ServerXMLHTTP
objXmlHttp.Open "GET", url, False, strUName, strUPass
objXmlHttp.send ""
Set objDomDoc = New MSXML2.DOMDocument
objDomDoc.LoadXML (objXmlHttp.responseText)
Set obj = objDomDoc.ChildNodes ' document階層
Set objs = get_childTAG(obj, "ResultSet") ' ResultSetの子階層取得
If (objs Is Nothing) Then
Set objXmlHttp = Nothing
Set get_USID_Info = Nothing
Exit Function
End If
' ユーザー情報の配列を作成
Set arrx = New Collection
For Each obj In objs
Set arry = CreateObject("Scripting.Dictionary")
Set objKey = obj.ChildNodes ' Resultの階層取得
For Each objsub In objKey
arry.Add objsub.nodeName, objsub.nodeTypedValue
Next objsub
arrx.Add arry
Set arry = Nothing
Next obj
Set get_USID_Info = arrx ' 連想配列の返却
Set objXmlHttp = Nothing
End Function
line12：実際のサーバ名、IPアドレスを入れてリクエストURLを作ります。
line15：今回は送るデータもほとんどないのでGETを利用し、同期処理(False)とました。
同期処理の場合
objXmlHttp.Open "GET", url, True, strUName, strUPass
objXmlHttp.send ""
While objXmlHttp.readyState <> 4
DoEvents
Wend
のように同期設定(True)とし、readyStateが4(応答完了)になるまで待機する必要があります。
非同期通信のメリットは応答待ち中もシステム動作が可能な点です。
line17：sendメソッドで設定したパラメータで送信します。
line25：希望するnode(ResultSetの子階層：Resultタグ)があるかの確認をします。
line32：ユーザー情報を取得します。
スケジュール情報の取得
続いてスケジュール情報のリクエストについて説明します。
'_/
'_/ GroupSessionスケジュール検索の取得
'_/
Private Function get_SCH_List_GET(strUName, strUPass, objUINF)
Dim url As String
Dim objDomDoc As MSXML2.DOMDocument
Dim objXmlHttp As MSXML2.ServerXMLHTTP
Dim adoStrm As New ADODB.Stream
Dim obj, objs, objsc, objr, objrc, objsub, objic, arry, arrSch As Object
Dim str As String
' 初期化
Set get_SCH_List_GET = Nothing
Set arrSch = New Collection
For Each objic In objUINF
url = "http://" & SEVER_IP & "/gsession/api/schedule/search.do?"
url = url & "usid=" & objic![Usrsid]
url = url & "&startFrom=" & "2014/06/04"
url = url & "&startTo=" & "2014/06/04"
url = url & "&endFrom=" & "2014/06/04"
url = url & "&endTo=" & "2014/06/04"
url = url & "&sameInputFlg=1"
Set objXmlHttp = New MSXML2.ServerXMLHTTP
objXmlHttp.Open "GET", url, True, strUName, strUPass
objXmlHttp.send ""
While objXmlHttp.readyState <> 4
DoEvents
Wend
Set objDomDoc = New MSXML2.DOMDocument
objDomDoc.LoadXML (objXmlHttp.responseText)
Set obj = objDomDoc.ChildNodes ' document階層
Set objr = get_childTAG(obj, "ResultSet") ' ResultSetの子階層取得
For Each objrc In objr
Set objs = objrc.ChildNodes
' スケジュール情報の連想配列を作成
If Not (objs Is Nothing) Then
Set arry = CreateObject("Scripting.Dictionary")
arry.Add "Naiyo", ""
arry.Add "StartDateTime", ""
arry.Add "ReserveSetName", ""
For Each objsc In objs ' Resultの子階層取得
If objsc.nodeName Like "AddUserName" Then
arry![User] = objsc.nodeTypedValue
End If
If objsc.nodeName Like "Naiyo" Then
arry![Naiyo] = objsc.nodeTypedValue
End If
If objsc.nodeName Like "StartDateTime" Then
arry![StartDateTime] = objsc.nodeTypedValue
End If
If objsc.nodeName Like "ReserveSet" Then
Set objsub = get_childTAG(objsc.ChildNodes, "Reserve")
Set objsub = get_TAG(objsub, "Name")
If Not objsub Is Nothing Then
arry![ReserveSetName] = objsub.nodeTypedValue
End If
End If
Next objsc
arrSch.Add arry
End If
Next objrc
objXmlHttp.abort : Set objXmlHttp = Nothing
Next objic
Set get_SCH_List_GET = arrSch ' 連想配列の返却
Set objXmlHttp = Nothing
End Function
line18：情報元である「objUINF」には複数ユーザーの情報が詰まっています。for each～next文でユーザーを回し暫定オブジェクトであるobjicからキー指定(objic![Usrsid])することによってユーザーSIDを取得しています。
line19：スケジュール日時をします。以前の記事にも書きましたが日時フォーマットは”yyyy/mm/dd”です。また、スケジュール開始日時(From,To)スケジュール終了日時(From,To)は同日に固定しています。実際はDate関数を利用して「当日」のスケジュールを検索するようします。
line23：施設予約状況も同時に取得するために「sameInputFlg=1」としています。
line50,53,56：スケジュール検索の応答から必要な情報を入手します。
入手情報の適用
ここまででユーザーSIDを基にスケジュール情報を入手してきました。最後にこれら情報をPowerPointのスライドに適用します。
Dim ax, ay, az As Object
Dim str As String
Dim bg, ln As Integer
Set ax = get_SCH_List_GET("hoge", "hoge", get_USID_Info("hoge", "hoge"))
str = Replace(ax(7)![Naiyo], " ", " ")
' 場所の入力
ActivePresentation.Slides(2).Shapes("L_場所").OLEFormat.Object.Caption = ax(7)![ReserveSetName]
' 時間の入力
ActivePresentation.Slides(2).Shapes("L_時間").OLEFormat.Object.Caption = ax(7)![StartDateTime]
' 会社名の入力
bg = InStr(str, "<CMP>") + Len("<CMP>")
ln = InStr(str, "</CMP>") - bg
ActivePresentation.Slides(2).Shapes("L_会社名").OLEFormat.Object.Caption = Mid(str, bg, ln)
' ご芳名の入力
bg = InStr(str, "<CST>") + Len("<CST>")
ln = InStr(str, "</CST>") - bg
ActivePresentation.Slides(2).Shapes("L_ご芳名").OLEFormat.Object.Caption = Mid(str, bg, ln)
' 担当の入力
bg = InStr(str, "<CHG>") + Len("<CHG>")
ln = InStr(str, "</CHG>") - bg
ActivePresentation.Slides(2).Shapes("L_担当").OLEFormat.Object.Caption = Mid(str, bg, ln)
ax(7)：スケジュールの7番目を意味します。表示の都合上固定値としています。
line5：get_USID_Info関数で入手したユーザー情報をget_SCH_List_GET関数に渡し、スケジュール一覧を得ます。
line7：GroupSessionのスケジュールで入力した内容(Naiyo)はHTMLで成形されており、空白も「 」に成形されています。スライドにそのまま表示してしまうと問題なので、空白に戻します。
line9,11：スケジュール情報から時間と場所を取得します。
line13～15：先の空白もそうでしたが、スケジュールの内容は全てHTMLに書き換えられています。GroupSessionではタグ入力しましたが、引き出した情報ではHTML表記に変わっているため抽出に工夫が必要です。
InStr(str, "<CMP>")
は会社タグ(HTML相当)の始まり位置を意味します。
Len("<CMP>")
は会社タグの文字列長さ(HTML相当)を意味します。
InStr(str, "</CST>")
は会社タグ(HTML相当)の終わり位置を意味します。
上図の関連から「bgは会社タグ情報の始まり位置」(例ではN+11)、「lnは会社タグ情報の長さ」(例ではM-[N+11])となります。
スライド内のコントロール参照
今回の事例では
ActivePresentation.Slides(2).Shapes("L_時間").OLEFormat.Object.Caption
のようにスライド内のコントロールを参照しています。各項目について簡単に説明します。
- ActivePresentation
- Slides
- Shapes
- OLEFormat / Object
- Caption
現在開いているプレゼンテーション(PowerPointファイル)を指定しています。
スライド番号を指定しています。
コントロール名を指定しています。テキストボックス等も同様に指定できます。
コントロールの場合はこのように指定します。
コントロールの表示内容になります。
今回はVBAを利用して「HTTPアクセス」「XML解析」「PowerPointコントロールへ摘要」までを行いました。
次回は実際に使うに当って絞り込むべきポイントについて説明したいと思います。
