List 6-163 変更したBusiness.SlipコンポーネントのRequestConsentメソッド（変更部分は赤色で示した）
1： Public Sub RequestConsent(ByVal SlipID As Long, ByVal Comment As Variant)
2： ' 指定された伝票を承認依頼中にする
3： ' 【引数】
4： ' SlipID = 承認依頼中としたい伝票の伝票番号
5： ' Comment = 承認依頼中にするときのコメント
6： ' 【戻り値】
7： ' なし
8： Dim objContext As ObjectContext
9： Dim objDataSlip As DataObj.Slip, objDataSlipInformation As DataObj.SlipInformation
10： Dim objDataSlipDetail As DataObj.SlipDetail
11： Dim objDataProduct As DataObj.Product, objDataStock As DataObj.STOCK
12： Dim SlipStatus As SlipStatus
13： Dim old_CUSTOMERID As Variant, old_SUBTOTAL As Variant, old_TAX As Variant
14： Dim old_TOTAL As Variant, old_MADEDATE As Variant, old_MADEUSER As Variant
15： Dim old_LASTUSER As Variant, old_LASTDATE As Variant
16： Dim old_ONEBILLFLAG As Variant, old_BILLID As Variant, old_BILLDATE As Variant
17： Dim objRecSlipDetail As ADODB.Recordset
18： Dim Number As Long, ProductID As Long
19： Dim old_DIVISION As Variant, old_PERSON As Variant, old_DELIVERDATE As Variant
20： Dim old_SENT_ADDR As Variant, old_SENT_TEL As Variant, old_MEMO As Variant
21： Dim nowStock As Long, willStock As Long
22：
23： ' オブジェクトコンテキストの取得
24： Set objContext = GetObjectContext()
25：
26： ' エラーハンドラの設定
27： On Error GoTo ErrHandle
28：
29： ' DataObj.Slipコンポーネントを実体化
30： Set objDataSlip = CreateObject("DataObj.Slip")
31：
32： ' 伝票が存在することを確認
33： If objDataSlip.IsDeleted(SlipID) <> ID_Exists Then
34： ' 伝票が存在しない
35： Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
"指定された伝票は存在しません"
36： End If
37：
38： ' 伝票の状態を取得
39： SlipStatus = objDataSlip.Get_SlipStatus(SlipID)
40： If (SlipStatus <> Creating) And (SlipStatus <> Rejected) Then
41： ' 伝票が作成中または却下されたという状態ではない
42： Err.Raise BusinessError.Err_CANTUPDATE, App.Title, _
"その伝票はすでに承認依頼されています"
43： End If
44：
45： ' ユーザーの確認
46： If Not objContext.IsSecurityEnabled() Then
47： ' セキュリティ設定が無効
48： Err.Raise ERR_NOSECURE, App.Title, _
"セキュリティ機構が無効です"
49： End If
50：
51： ' その時点の伝票の情報を取得
52： objDataSlip.GetRecord_Slip SlipID, old_CUSTOMERID, _
old_SUBTOTAL, old_TAX, old_TOTAL, _
old_MADEDATE, old_MADEUSER, _
old_LASTDATE, old_LASTUSER
53： ' 作成者と呼び出し者が一致するか
54： If objContext.Security.GetOriginalCallerName() <> old_MADEUSER Then
55： ' 一致しない
56： ' SalesAdminロールまたはAllAdminロールに属するのであれば，
57： ' 一致しなくてもよいものとする
58： If Not (objContext.IsCallerInRole("SalesAdmin") Or _
objContext.IsCallerInRole("AllAdmin")) Then
59： ' SalesAdminロールやAllAdminロールに属さない
60： Err.Raise ERR_NOSECURE, App.Title, _
"他人が作成した伝票を更新することはできません"
61： End If
62： End If
63：
64： ' 以上で権限の調査は完了。以下，実際のデータ操作に入る
65：
66： ' REQ_CONSENTFLAGフィールドの値をTrueにする
67： objDataSlip.Set_REQ_CONSENTFLAG SlipID, True, Comment
68： ' REJECTEDFLAGフィールドの値をFalseにする
69： objDataSlip.Set_REJECTEDFLAG SlipID, False, Null
70：
71： ' 在庫の調査
72：
73： ' その時点の伝票追加情報の取得
74： ' DataObj.SlipInformationコンポーネントの実体化
75： Set objDataSlipInformation = CreateObject("DataObj.SlipInformation")
76： objDataSlipInformation.GetRecord SlipID, old_DIVISION, _
old_PERSON, old_DELIVERDATE, _
old_SENT_ADDR, old_SENT_TEL, old_MEMO, _
old_MADEDATE, old_MADEUSER, _
old_LASTDATE, old_LASTUSER
77：
78： ' その時点の明細レコードの取得
79： ' DataObj.SlipDetailコンポーネントの実体化
80： Set objDataSlipDetail = CreateObject("DataObj.SlipDetail")
81： Set objRecSlipDetail = objDataSlipDetail.GetRecords(SlipID)
82：
83： ' DataObj.Productコンポーネントの実体化
84： Set objDataProduct = CreateObject("DataObj.Product")
85： ' DataObj.Stockコンポーネントの実体化
86： Set objDataStock = CreateObject("DataObj.Stock")
87：
88： ' すべての明細についてループ
89： While Not objRecSlipDetail.EOF
90： If Not objRecSlipDetail.Fields("DELETEDFLAG").Value Then
91： ' 削除ずみでないならば在庫を調査
92： ProductID = objRecSlipDetail.Fields("PRODUCTID").Value
93： Number = objRecSlipDetail.Fields("NUMBER").Value
94：
95： ' その時点の在庫数を取得
96： nowStock = objDataProduct.GetNowStock(ProductID)
97：
98： ' 納入予定日までに到着する予定の数量を取得
99： willStock = objDataStock.GetWillStock(ProductID, old_DELIVERDATE)
100：
101： ' 在庫が足りるかどうか
102： If (nowStock + willStock < Number) Then
103： ' 在庫が足りない
104： Err.Raise Err_CANTUPDATE, App.Title, _
"製品[" & objRecSlipDetail.Fields("PRODUCTNAME").Value & "］" & _
"が納入予定日までに揃いません。納入予定日までに揃う数量は" & _
nowStock + willStock & "個です"
105： End If
106：
107： ' 予約数を加える
108： objDataProduct.AddBackOrder ProductID, Number
109：
110： End If
111：
112： ' 次のレコードに移動
113： objRecSlipDetail.MoveNext
114： Wend
115：
116： objRecSlipDetail.Close
117： Set objRecSlipDetail = Nothing
118：
119： ' 各種コンポーネントの解放
120： Set objDataStock = Nothing
121： Set objDataProduct = Nothing
122： Set objDataSlipDetail = Nothing
123： Set objDataSlipInformation = Nothing
124： Set objDataSlip = Nothing
125：
126： ' トランザクションのコミット
127： objContext.SetComplete
128：
129： ' オブジェクトコンテキストの解放
130： Set objContext = Nothing
131：
132： ' 伝票の合計金額がg_MaxTotal以下であれば，承認処理に進む
133： If old_TOTAL <= g_MaxTotal Then
134： ConsentSlip SlipID, Null
135： End If
136：
137： Exit Sub
138：
139： ErrHandle:
140： ' エラーハンドラ
141： objContext.SetAbort
142： Set objDataSlip = Nothing
143： Set objDataSlipInformation = Nothing
144： Set objDataSlipDetail = Nothing
145： Set objDataProduct = Nothing
146： Set objDataStock = Nothing
147： Set objRecSlipDetail = Nothing
148：
149： ' エラーの再発行
150： Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
151： End Sub