ガルーンのSOAP APIをVBScriptやVBAから呼び出して、ユーザーアカウントの登録作業を自動化するサンプルプログラム紹介記事の後半をお送りします。
前回の記事では、APIの基礎知識や、実際にガルーンのAPIを呼び出してVBSからガルーンにログインしてログアウトするところまでのサンプルプログラムを紹介しました。
もし前編をお読みになっていない方は以下のリンクから先に前編の記事を一読されることをおススメします。
今回の記事では基礎的な解説はあまり挟まずに、サンプルプログラムをダラダラと書いていきます。
サンプルプログラムの概要説明
前回に引き続き、サンプルプログラムはVBScriptで作成します。
尚、プログラムの言語仕様はVBAと共通であり、参照設定の遅延バインディングでも支障がなければ、当記事のコードのSubプロシージャやFunctionプロシージャをコピペしてもらえれば、VBAでもそのまま動くと思います。
サンプルコードの前提条件
- ガルーンの「ログインユーザー名」は別システムDB内社員マスタの社員番号とする。
- 別システムDBに持つ社員マスタの更新日を条件にガルーン反映対象の元データを取得する。
- 別システムDBでは部門(部署)マスタを持ち、そのマスタの部門コードをガルーンの組織コードで使用する。
- 別システムDBでもつ部門(部署)マスタと同じ組織構成の「組織」が既にガルーンにも登録されていること。
- ガルーン内のユーザーごとの所属組織は末端の所属組織から最上位の親組織まで全て重ね付けする。
- ガルーンへの登録処理などでエラーが出た場合のエラー処理は割愛する。
尚、当処理では、ガルーンのユーザー登録をするAPI以外にも以下のAPIを実行しています。
| API名 | 機能 |
|---|---|
| AdminGetUserIdByLoginName | 「ログイン名」を渡すとガルーンの内部的なユーザー識別番号の「ユーザーID」を返します。 |
| AdminGetOrgIdByOrgCode | 「組織コード」を渡すとガルーンの内部的な組織識別番号の「組織ID」を返します。 |
| AdminGetParentOrgId | 「組織ID」を渡すとガルーンに登録された組織階層における親組織の「組織ID」を返します。 |
| AdminAddUserAccount | ユーザー情報を渡すと、その値を元にガルーン内に新規ユーザーを作成して、ユーザー情報の一部を返します。 |
| AdminModifyUserAccount | ユーザーIDとユーザー情報を渡すと、その値を元にガルーン内に対象のユーザー情報を更新して、ユーザー情報の一部を返します。 |
| AdminCountUsers | ガルーンに登録されているユーザー数を返します。パラメーターは不要。 |
これらのAPIをプログラムに組み込んで必要によって呼び出すことで、一連の登録処理を実現しています。
尚、上記APIの詳細な仕様についてはサイボウズ社のデベロッパーサイトでご確認ください。
ガルーンのユーザー登録APIを呼び出すサンプルプログラム
中の人
サンプルプログラムとはいえ、かなりの行数があります。
頑張って処理を読み解いてください。。。
2022年2月追記
サンプルコードの一部に記述の誤りがあったため、修正させていただきました。
もし当コードを参考に実装しようとしていた場合はエラーになっていたと思われます。
申し訳ありません。
Option Explicit
'データベース接続情報を定義します。
CONST DBSRV_NAME = "DBサーバーのホスト名orIPアドレス"
CONST DB_NAME = "DB名"
CONST DBLOGIN_NAME = "DBユーザー名"
CONST DBLOGIN_PASS = "DBパスワード"
'ガルーンのAPI関連情報を定義します。
CONST BASE_URL = "http://example.com/scripts/cbgrn/grn.exe/"
CONST LOGIN_API_DIR = "util_api/util/api?"
CONST LOGIN_API_NAME = "UtilLogin"
CONST LOGIN_USERNAME = "Administrator"
CONST LOGIN_PASSWORD = "xxxxxxxxx"
CONST ACTION_API_DIR = "sysapi/admin/api?"
'メイン処理を実行します。
Call GaroonAPI_Executor
Sub GaroonAPI_Executor()
ReDim Para(3,1)
Dim objHTTP
Dim Full_URL
Dim retCd
Dim sEnv
Dim objXML
Dim rtnVal
Dim elm
Dim query
Dim tempMessage
Dim objRS
Dim objCon
Dim ReqXML
Dim orgId
Dim userId
Dim objRsPara
Dim LoopFlag
Dim RtnUserCount
'*****************************************************************
'処理1：更新対象のデータをデータベースから取得します。
'*****************************************************************
'例：SQL Serverの場合の接続文字列
Set objCon = CreateObject("ADODB.Connection")
objCon.Open "Driver={SQL Server};" & _
" server=" & DBSRV_NAME & "; database=" & DB_NAME & "; uid=" & DBLOGIN_NAME & "; pwd=" & DBLOGIN_PASS & ";"
'変更が発生した社員データを取得します。
query = "SELECT 社員番号,氏名,氏名ひらがな,パスワード,所属部門コード "
query = query & "FROM "
query = query & " 社員マスタ的なテーブル "
query = query & "WHERE "
query = query & " 更新日的な列 >= 今日の日付などの条件"
Set objRS = objCon.Execute(query)
'レコードが存在していなければ処理を終了します。
If objRS.EOF Then
objCon.Close
Set objRS = Nothing
Set objCon = Nothing
Exit Sub
End If
'*****************************************************************
'処理2：ガルーンのユーザー情報に反映する処理を開始します。
'*****************************************************************
'ユーザー情報を登録時に使用するパラメーターを格納するレコードセットを生成します。
Set objRsPara = CreateObject("ADODB.Recordset")
'レコードセットの列を定義します。
objRsPara.Fields.Append "login_name",20 '20:adBigInt
objRsPara.Fields.Append "display_name",200,50 '200:VarChar(50)
objRsPara.Fields.Append "password_raw",200,50 '200:VarChar(50)
objRsPara.Fields.Append "primary_group",20 '20:adBigInt
objRsPara.Fields.Append "position",20 '20:adBigInt
objRsPara.Fields.Append "invalid",200,50 '200:VarChar(50)
objRsPara.Fields.Append "sort_key",200,50 '200:VarChar(50)
objRsPara.Fields.Append "email_address",200,50 '200:VarChar(50)
objRsPara.Fields.Append "description",200,50 '200:VarChar(50)
objRsPara.Fields.Append "post",200,50 '200:VarChar(50)
objRsPara.Fields.Append "telephone_number",200,50 '200:VarChar(50)
objRsPara.Fields.Append "url",200,50 '200:VarChar(50)
objRsPara.Fields.Append "locale",200,50 '200:VarChar(50)
objRsPara.Fields.Append "base",200,50 '200:VarChar(50)
objRsPara.Fields.Append "image",200,50 '200:VarChar(50)
objRsPara.Open
'疑似continue用のフラグを立てます。
LoopFlag = True
'データ件数分ループします。
Do Until objRS.EOF
'処理の途中で次のループにスキップしたい場合、疑似的にcontinueさせるために1回だけのループを作成します。
Do
'社員マスタの「所属部門コード」からガルーンの組織IDを取得します。
orgId = ExeAPI_AdminGetOrgIdByOrgCode(objRS("部門コード").Value)
If orgId = -1 Then
'ガルーンに登録されていない組織コードのため処理をスキップします。
'必要によってログに残すなどの処理を以下で実装してください。
'ループ最後尾の処理まで飛ばします。
Exit Do
ElseIf orgId = 0 Then
'組織コード取得処理でエラーが発生したため処理をスキップします。
'必要によってログに残すなどの処理を以下で実装してください。
'ループ最後尾の処理まで飛ばします。
Exit Do
End If
'パラメーター用レコードセットに値をセットします。
'以下の例では一部の項目しかセットしていませんが、
'必要によって変更してください。
objRsPara.AddNew
objRsPara("login_name").Value = objRS("社員番号").Value
objRsPara("display_name").Value = objRS("氏名").Value
objRsPara("password_raw").Value = objRS("パスワード").Value
objRsPara("primary_group").Value = orgId
'表示優先度は「なし」が100000000※空文字列だと「無し」にならない
objRsPara("position").Value = 100000000
objRsPara("invalid").Value = false
objRsPara("sort_key").Value = objRS("氏名ひらがな").Value
objRsPara("email_address").Value = ""
objRsPara("description").Value = ""
objRsPara("post").Value = ""
objRsPara("telephone_number").Value = ""
objRsPara("url").Value = ""
objRsPara("locale").Value = ""
objRsPara("base").Value = ""
objRsPara("image").Value = ""
objRsPara.Update
'ガルーン内に対象のログイン名が存在するかをチェックします。
userId = ExeAPI_AdminGetUserIdByLoginName(objRS("社員番号").Value)
Select Case userId
Case "0"
'ガルーン内のログイン名存在チェックでエラーが発生。
'必要によってログに残すなどの処理を以下で実装してください。
'ループ最後尾の処理まで飛ばします。
Exit Do
Case "-1"
'対象のユーザーが存在しない場合は追加
retCd = ExeAPI_AdminAddUserAccount(objRsPara)
'レコードセットの社員番号とExeAPI_AdminAddUserAccountの戻り値が同じ値
'の場合は登録成功と判定します。
If CStr(retCd) = Cstr(objRS("社員番号").Value) Then
'登録成功
'必要によってログに残すなどの処理を以下で実装してください。
Else
'登録失敗
'必要によってログに残すなどの処理を以下で実装してください。
End If
Case Else
'0でも-1でも無い値が戻る場合はガルーンのユーザーIDであり、
'対象のユーザーが存在することになるため、ガルーンのユーザー情報を更新します。
retCd = ExeAPI_AdminModifyUserAccount(userId,objRsPara)
If CStr(retCd) = Cstr(objRS("社員番号").Value) Then
'更新成功
'必要によってログに残すなどの処理を以下で実装してください。
Else
'更新失敗
'必要によってログに残すなどの処理を以下で実装してください。
End If
End Select
'処理をスキップした場合にここまで飛ばされます。
Loop Until LoopFlag
objRS.MoveNext
Loop
'*****************************************************************
'処理3；終了処理を開始します。
'*****************************************************************
'ガルーン内の登録ユーザー数を取得して通知します。
RtnUserCount = ExeAPI_AdminCountUsers()
If RtnUserCount = -1 Then
'ガルーン登録ユーザー取得処理で失敗
'必要によってログに残すなどの処理を以下で実装してください。
Else
'ガルーンの登録ユーザー数の取得に成功
'変数に格納したユーザー数は保有ライセンス数超過のチェックで必要になるため、
'メール等で管理者に通知することをおススメします。
'必要によって処理を以下で実装してください。
End If
objCon.Close
Set objRS = Nothing
Set objRsPara = Nothing
Set objCon = Nothing
End Sub
'*****************************************************************
'以下は関数群です。
'*****************************************************************
'ガルーンのAPIを実行し、登録されているユーザーアカウント数を返します。
'引数1：無し
'戻り値：ユーザー数
'*****************************************************************
Function ExeAPI_AdminCountUsers()
Dim objHTTP
Dim Full_URL
Dim sEnv
Dim ReqXML
Dim objXML
Dim retCd
Dim elm
Dim rtnVal
Full_URL = BASE_URL & ACTION_API_DIR
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
'リクエスト用xml文字列を生成します。※パラメーター無し
sEnv = " <soap:Body>"
sEnv = sEnv & " <AdminCountUsers>"
sEnv = sEnv & " </AdminCountUsers>"
sEnv = sEnv & " </soap:Body>"
sEnv = sEnv & "</soap:Envelope>"
ReqXML = Get_CreateXML_Header("AdminCountUsers") & vbcrlf & sEnv
'リクエストをPOSTします。
objHTTP.Open "POST", Full_URL, False
objHTTP.send ReqXML
retCd = objHTTP.Status
If retCd <> 200 Then
'httpレスポンスコードが異常な場合は-1を返します。
ExeAPI_AdminCountUsers = -1
Set objHTTP = Nothing
Set ReqXML = Nothing
Exit Function
End If
'XML解析用のオブジェクトを生成します。
Set objXML = CreateObject("MSXML2.DOMdocument")
'レスポンスをxmlで読み込みます。
objXML.LoadXML(objHTTP.ResponseText)
For Each elm In objXML.getElementsByTagName("returns")
'目的の値を取得します。
rtnVal = elm.getElementsByTagName("number_users")(0).text
Next
ExeAPI_AdminCountUsers = rtnVal
Set objHTTP = Nothing
Set ReqXML = Nothing
End Function
'*****************************************************************
'引数で渡されたガルーン内のユーザーIDとパラメーターを元にガルーンのユーザー情報を更新します。
'引数1：ガルーンのユーザーID
'引数2：パラメーター(レコードセット)
'戻り値：更新されたログイン名 ※異なる値の場合は失敗
'*****************************************************************
Function ExeAPI_AdminModifyUserAccount(userid,RsPara)
Dim objHTTP
Dim Full_URL
Dim sEnv
Dim ReqXML
Dim objXML
Dim ArrOrgID
Dim OrgID
Dim retCd
Dim elm
Dim rtnVal
Full_URL = BASE_URL & ACTION_API_DIR
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
'渡された引数のレコードセットを元に、リクエスト用xml文字列を生成します。
sEnv = " <soap:Body>"
sEnv = sEnv & " <AdminModifyUserAccount>"
sEnv = sEnv & " <parameters>"
sEnv = sEnv & " <userId xmlns="""">" & userid & "</userId>"
sEnv = sEnv & " <login_name xmlns="""">" & RsPara("login_name").Value & "</login_name>"
sEnv = sEnv & " <display_name xmlns="""">" & RsPara("display_name").Value & "</display_name>"
sEnv = sEnv & " <password_raw xmlns="""">" & RsPara("password_raw").Value & "</password_raw>"
sEnv = sEnv & " <user_info xmlns="""""
sEnv = sEnv & " primary_group=""" & RsPara("primary_group").Value & """ "
sEnv = sEnv & " position=""" & RsPara("position").Value & """ "
sEnv = sEnv & " invalid=""" & RsPara("invalid").Value & """ "
sEnv = sEnv & " sort_key=""" & RsPara("sort_key").Value & """ "
sEnv = sEnv & " email_address=""" & RsPara("email_address").Value & """ "
sEnv = sEnv & " description=""" & RsPara("description").Value & """ "
sEnv = sEnv & " post=""" & RsPara("post").Value & """ "
sEnv = sEnv & " telephone_number=""" & RsPara("telephone_number").Value & """ "
sEnv = sEnv & " url=""" & RsPara("url").Value & """ "
sEnv = sEnv & " locale=""" & RsPara("locale").Value & """ "
sEnv = sEnv & " base=""" & RsPara("base").Value & """ "
sEnv = sEnv & " image=""" & RsPara("image").Value & """ "
sEnv = sEnv & " >"
'組織IDから親組織IDも全て配列で取得します。
ArrOrgID = Get_ArrParentOrgId(RsPara("primary_group").Value)
'親組織全てのOrgIDをxmlに追加します。
For Each OrgID In ArrOrgID
sEnv = sEnv & " <organization>" & OrgID & "</organization>"
Next
sEnv = sEnv & " </user_info>"
sEnv = sEnv & " </parameters>"
sEnv = sEnv & " </AdminModifyUserAccount>"
sEnv = sEnv & " </soap:Body>"
sEnv = sEnv & "</soap:Envelope>"
ReqXML = Get_CreateXML_Header("AdminModifyUserAccount") & vbcrlf & sEnv
'リクエストをPOSTします。
objHTTP.Open "POST", Full_URL, False
objHTTP.send ReqXML
retCd = objHTTP.Status
If retCd <> 200 Then
'httpレスポンスコードが異常な場合は-1を返します。
ExeAPI_AdminModifyUserAccount = -1
Set objHTTP = Nothing
Set ReqXML = Nothing
Exit Function
End If
'XML解析用のオブジェクトを生成します。
Set objXML = CreateObject("MSXML2.DOMdocument")
'レスポンスをxmlで読み込みます。
objXML.LoadXML(objHTTP.ResponseText)
For Each elm In objXML.getElementsByTagName("returns")
'目的の値を取得します。
rtnVal = elm.getElementsByTagName("login_name")(0).text
Next
ExeAPI_AdminModifyUserAccount = rtnVal
Set objHTTP = Nothing
Set ReqXML = Nothing
End Function
'*****************************************************************
'引数で渡されたパラメーターを元にガルーンに新規ユーザーを登録します。
'引数1：パラメーター用レコードセット
'戻り値：登録されたログイン名 ※異なる値の場合は失敗
'*****************************************************************
Function ExeAPI_AdminAddUserAccount(RsPara)
Dim objHTTP
Dim Full_URL
Dim sEnv
Dim ReqXML
Dim objXML
Dim ArrOrgID
Dim OrgID
Dim retCd
Dim elm
Dim rtnVal
Full_URL = BASE_URL & ACTION_API_DIR
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
'渡された引数のレコードセットを元に、リクエスト用xml文字列を生成します。
sEnv = " <soap:Body>"
sEnv = sEnv & " <AdminAddUserAccount>"
sEnv = sEnv & " <parameters>"
sEnv = sEnv & " <login_name xmlns="""">" & RsPara("login_name").Value & "</login_name>"
sEnv = sEnv & " <display_name xmlns="""">" & RsPara("display_name").Value & "</display_name>"
sEnv = sEnv & " <password_raw xmlns="""">" & RsPara("password_raw").Value & "</password_raw>"
sEnv = sEnv & " <user_info xmlns="""""
sEnv = sEnv & " primary_group=""" & RsPara("primary_group").Value & """ "
sEnv = sEnv & " position=""" & RsPara("position").Value & """ "
sEnv = sEnv & " invalid=""" & RsPara("invalid").Value & """ "
sEnv = sEnv & " sort_key=""" & RsPara("sort_key").Value & """ "
sEnv = sEnv & " email_address=""" & RsPara("email_address").Value & """ "
sEnv = sEnv & " description=""" & RsPara("description").Value & """ "
sEnv = sEnv & " post=""" & RsPara("post").Value & """ "
sEnv = sEnv & " telephone_number=""" & RsPara("telephone_number").Value & """ "
sEnv = sEnv & " url=""" & RsPara("url").Value & """ "
sEnv = sEnv & " locale=""" & RsPara("locale").Value & """ "
sEnv = sEnv & " base=""" & RsPara("base").Value & """ "
sEnv = sEnv & " image=""" & RsPara("image").Value & """ "
sEnv = sEnv & " >"
'組織IDから親組織IDも全て配列で取得します。
ArrOrgID = Get_ArrParentOrgId(RsPara("primary_group").Value)
'親組織全てのOrgIDをxmlに追加します。
For Each OrgID In ArrOrgID
sEnv = sEnv & " <organization>" & OrgID & "</organization>"
Next
sEnv = sEnv & " </user_info>"
sEnv = sEnv & " </parameters>"
sEnv = sEnv & " </AdminAddUserAccount>"
sEnv = sEnv & " </soap:Body>"
sEnv = sEnv & "</soap:Envelope>"
ReqXML = Get_CreateXML_Header("AdminAddUserAccount") & vbcrlf & sEnv
'リクエストをPOSTします。
objHTTP.Open "POST", Full_URL, False
objHTTP.send ReqXML
retCd = objHTTP.Status
If retCd <> 200 Then
'httpレスポンスコードが異常な場合は-1を返します。
ExeAPI_AdminAddUserAccount = -1
Set objHTTP = Nothing
Set ReqXML = Nothing
Exit Function
End If
'XML解析用のオブジェクトを生成します。
Set objXML = CreateObject("MSXML2.DOMdocument")
'レスポンスをxmlで読み込みます。
objXML.LoadXML(objHTTP.ResponseText)
For Each elm In objXML.getElementsByTagName("returns")
'目的の値を取得します。
rtnVal = elm.getElementsByTagName("login_name")(0).text
Next
ExeAPI_AdminAddUserAccount = rtnVal
Set objHTTP = Nothing
Set ReqXML = Nothing
End Function
'*****************************************************************
'ガルーンの末端組織IDから親の組織IDをすべて取得して、配列で返します。
'引数1：所属組織ID
'戻り値：親組織全て(配列)
'*****************************************************************
Function Get_ArrParentOrgId(child_orgId)
Dim RtnOrgID
Dim i
ReDim ArrOrgID(0)
RtnOrgID = child_orgId
ArrOrgID(0) = RtnOrgID
'念の為、無限ループ防止のためにFor文とします。
'回数の上限を6とするのは、決め打ちで6階層以上組織が作られることはないという予測から。
For i = 1 To 6
RtnOrgID = ExeAPI_AdminGetParentOrgId(RtnOrgID)
Select Case RtnOrgID
Case 0
'組織IDのルートまで到達したため、ループを抜けます。
Exit For
Case -1
'親組織取得時にエラーが発生したため、ループを抜けます。
Exit For
Case Else
'取得した親組織IDを配列に格納します。
ReDim PreServe ArrOrgID(i)
ArrOrgID(i) = RtnOrgID
End Select
Next
'配列を戻り値にセットします。
Get_ArrParentOrgId = ArrOrgID
End Function
'*****************************************************************
'ガルーンのAPI(AdminGetParentOrgId)を実行し、引数の組織IDから親組織IDを返します。
'引数1：組織ID
'戻り値：親組組織ID
'*****************************************************************
Function ExeAPI_AdminGetParentOrgId(OrgId)
Dim objHTTP
Dim Full_URL
Dim sEnv
Dim ReqXML
Dim objXML
Dim elm
Dim rtnVal
sEnv = " <soap:Body>"
sEnv = sEnv & " <AdminGetParentOrgId>"
sEnv = sEnv & " <parameters>"
sEnv = sEnv & " <child_orgId xmlns="""">" & OrgId & "</child_orgId>"
sEnv = sEnv & " </parameters>"
sEnv = sEnv & " </AdminGetParentOrgId>"
sEnv = sEnv & " </soap:Body>"
sEnv = sEnv & "</soap:Envelope>"
Full_URL = BASE_URL & ACTION_API_DIR
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
ReqXML = Get_CreateXML_Header("AdminGetParentOrgId") & vbcrlf & sEnv
'パラメーターを渡します。
objHTTP.Open "POST", Full_URL, False
objHTTP.send ReqXML
If objHTTP.Status <> 200 Then
'httpレスポンスコードが異常な場合は戻り値に-1を返します。
ExeAPI_AdminGetParentOrgId = -1
Set objHTTP = Nothing
Exit Function
End If
'XML解析用のオブジェクトを生成します。
Set objXML = CreateObject("MSXML2.DOMdocument")
'レスポンスをxmlで読み込みます。
objXML.LoadXML(objHTTP.ResponseText)
For Each elm In objXML.getElementsByTagName("returns")
'目的の値を取得します。
rtnVal = elm.getElementsByTagName("parent_orgId")(0).text
Next
ExeAPI_AdminGetParentOrgId = rtnVal
Set objHTTP = Nothing
Set objXML = Nothing
End Function
'*****************************************************************
'ガルーンのAPI(AdminGetOrgIdByOrgCode)を実行し、引数の組織コード(部門コード)から組織IDを返します。
'引数1：組織コード
'戻り値：組織ID
'※ガルーン内に存在しなければ、-1を返し、エラーが出た場合は0を返します。
'*****************************************************************
Function ExeAPI_AdminGetOrgIdByOrgCode(OrgCode)
Dim objHTTP
Dim Full_URL
Dim sEnv
Dim ReqXML
Dim objXML
Dim elm
Dim rtnVal
sEnv = " <soap:Body>"
sEnv = sEnv & " <AdminGetOrgIdByOrgCode>"
sEnv = sEnv & " <parameters>"
sEnv = sEnv & " <org_code xmlns="""">" & OrgCode & "</org_code>"
sEnv = sEnv & " </parameters>"
sEnv = sEnv & " </AdminGetOrgIdByOrgCode>"
sEnv = sEnv & " </soap:Body>"
sEnv = sEnv & "</soap:Envelope>"
Full_URL = BASE_URL & ACTION_API_DIR
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
ReqXML = Get_CreateXML_Header("AdminGetOrgIdByOrgCode") & vbcrlf & sEnv
'パラメーターを渡します。
objHTTP.Open "POST", Full_URL, False
objHTTP.send ReqXML
If objHTTP.Status <> 200 Then
'httpレスポンスコードが異常な場合は戻り値に0を返します。
ExeAPI_AdminGetOrgIdByOrgCode = 0
Set objHTTP = Nothing
Exit Function
End If
'XML解析用のオブジェクトを生成します。
Set objXML = CreateObject("MSXML2.DOMdocument")
'レスポンスをxmlで読み込みます。
objXML.LoadXML(objHTTP.ResponseText)
For Each elm In objXML.getElementsByTagName("returns")
'目的の値を取得します。
rtnVal = elm.getElementsByTagName("orgId")(0).text
Next
ExeAPI_AdminGetOrgIdByOrgCode = rtnVal
Set objHTTP = Nothing
Set objXML = Nothing
End Function
'*****************************************************************
'ガルーンのAPI(AdminGetUserIdByLoginName)を実行し、引数のログイン名(社員番号)からユーザーIDを返します。
'引数1：ログイン名
'戻り値：ユーザーID
'※ガルーン内に存在しなければ、-1を返し、エラーが出た場合は0を返します。
'*****************************************************************
Function ExeAPI_AdminGetUserIdByLoginName(DBLOGIN_NAME)
Dim objHTTP
Dim Full_URL
Dim sEnv
Dim ReqXML
Dim objXML
Dim elm
Dim rtnVal
sEnv = " <soap:Body>"
sEnv = sEnv & " <AdminGetUserIdByLoginName>"
sEnv = sEnv & " <parameters>"
sEnv = sEnv & " <login_name xmlns="""">" & DBLOGIN_NAME & "</login_name>"
sEnv = sEnv & " </parameters>"
sEnv = sEnv & " </AdminGetUserIdByLoginName>"
sEnv = sEnv & " </soap:Body>"
sEnv = sEnv & "</soap:Envelope>"
Full_URL = BASE_URL & ACTION_API_DIR
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
ReqXML = Get_CreateXML_Header("AdminGetUserIdByLoginName") & vbcrlf & sEnv
'パラメーターを渡します。
objHTTP.Open "POST", Full_URL, False
objHTTP.send ReqXML
If objHTTP.Status <> 200 Then
'httpレスポンスコードが異常な場合は戻り値に0を返します。
ExeAPI_AdminGetUserIdByLoginName = 0
Set objHTTP = Nothing
Exit Function
End If
'XML解析用のオブジェクトを生成します。
Set objXML = CreateObject("MSXML2.DOMdocument")
'レスポンスをxmlで読み込みます。
objXML.LoadXML(objHTTP.ResponseText)
For Each elm In objXML.getElementsByTagName("returns")
'目的の値を取得します。
rtnVal = elm.getElementsByTagName("userId")(0).text
Next
ExeAPI_AdminGetUserIdByLoginName = rtnVal
Set objHTTP = Nothing
Set objXML = Nothing
End Function
'*****************************************************************
'リクエストで使用するXMLヘッダーの文字列を生成して返します。
'引数1：API名
'戻り値：ヘッダー用XML文字列
'*****************************************************************
Function Get_CreateXML_Header(API_Name)
Dim sEnv
sEnv = "<?xml version=""1.0"" encoding=""UTF-8""?>"
sEnv = sEnv & "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"">"
sEnv = sEnv & " <soap:Header>"
sEnv = sEnv & " <Action>" & API_Name & "</Action>"
sEnv = sEnv & " <Security>"
sEnv = sEnv & " <UsernameToken>"
sEnv = sEnv & " <Username>" & LOGIN_USERNAME & "</Username>"
sEnv = sEnv & " <Password>" & LOGIN_PASSWORD & "</Password>"
sEnv = sEnv & " </UsernameToken>"
sEnv = sEnv & " </Security>"
sEnv = sEnv & " <Timestamp>"
sEnv = sEnv & " <Created>2010-08-12T14:45:00Z</Created>"
sEnv = sEnv & " <Expires>2037-08-12T14:45:00Z</Expires>"
sEnv = sEnv & " </Timestamp>"
sEnv = sEnv & " <Locale>jp</Locale>"
sEnv = sEnv & " </soap:Header>"
Get_CreateXML_Header = sEnv
End Function
'*****************************************************************
'上記サンプルコードでは使用していませんが、リクエスト用のXML作成時に
'Timestamp用の書式で指定した日時を返す関数です。
'引数1：n分後の数字※0を指定した場合は0分後(今)の日時
'戻り値：XMLで使用する書式の日時文字列
'*****************************************************************
Function Get_forTimestampDate(add_Minutes)
Dim wkNow
'yyyy-mm-ddThh:mm:ssZの書式に変換します。
wkNow = Year(Dateadd("n",add_Minutes,Now()))
wkNow = wkNow & "-" & Right("0" & Month(Dateadd("n",add_Minutes,Now())) , 2)
wkNow = wkNow & "-" & Right("0" & Day(Dateadd("n",add_Minutes,Now())) , 2)
wkNow = wkNow & "T" & Right("0" & Hour(Dateadd("n",add_Minutes,Now())) , 2)
wkNow = wkNow & ":" & Right("0" & Minute(Dateadd("n",add_Minutes,Now())) , 2)
wkNow = wkNow & ":" & Right("0" & Second(Dateadd("n",add_Minutes,Now())) , 2)
wkNow = wkNow & "Z"
Get_forTimestampDate = wkNow
End Function
最後に
今回は長々とサンプルプログラムを貼り付けただけの記事ですが、基本的には記事冒頭で定義している「前提条件」にある内容と同じような設計であれば、ほぼこのままの実装で動くと思います。
また、複数のSOAP APIを一連のプログラムに組み込んでおり、それぞれのAPIの呼び出し処理はある程度共通化しているので、そのあたりを参考にしながら自社用に修正しつつ実装していただくと良いかと思います。
グループウェアのユーザーアカウントの登録や変更などは情シスなどの企業のシステム管理者の仕事ですが、非常に面倒な作業です。
この様にAPIを活用することで、ユーザー情報のメンテナンスは自動化されて業務の省力化に繋がります。
もし、これまでガルーンを利用していてAPIの活用が出来ていなければ、是非活用していただくことをおススメします。
今回も長々とした記事を読んでいただきましてありがとうございます。
それでは皆さまごきげんよう！
