List 6-161 Business.SlipコンポーネントのCancelConsentSlipメソッド
1： Public Sub CancelConsentSlip(ByVal SlipID As Long)
2： ' 指定された伝票を承認ずみから承認依頼中に戻す
3： ' 【引数】
4： ' SlipID = 承認依頼中に戻したい伝票の伝票番号
5： ' 【戻り値】
6： ' なし
7： Dim objContext As ObjectContext
8： Dim objDataSlip As DataObj.Slip
9： Dim objDataStock As DataObj.STOCK
10： Dim objRecStock As ADODB.Recordset
11： Dim SlipStatus As SlipStatus
12： Dim CONSENTEDUSER As Variant, CONSENTEDDATE As Variant, CONSENTEDCOMMENT As Variant
13： Dim old_REQDATE As Variant, old_REQUSER As Variant, old_REQCOMMENT As Variant
14： Dim old_CUSTOMERID As Variant, old_SUBTOTAL As Variant, old_TAX As Variant
15： Dim old_TOTAL As Variant, old_MADEDATE As Variant, old_MADEUSER As Variant
16： Dim old_LASTUSER As Variant, old_LASTDATE As Variant
17：
18： ' オブジェクトコンテキストの取得
19： Set objContext = GetObjectContext()
20：
21： ' エラーハンドラの設定
22： On Error GoTo ErrHandle
23：
24： ' DataObj.Slipコンポーネントを実体化
25： Set objDataSlip = CreateObject("DataObj.Slip")
26：
27： ' 伝票が存在することを確認
28： If objDataSlip.IsDeleted(SlipID) <> ID_Exists Then
29： ' 伝票が存在しない
30： Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
"指定された伝票は存在しません"
31： End If
32：
33： ' 伝票の状態を取得
34： SlipStatus = objDataSlip.Get_SlipStatus(SlipID)
35： If (SlipStatus <> Consented) Then
36： ' 伝票が承認ずみではない
37： Err.Raise BusinessError.ERR_CANTUPDATE, App.Title, _
"その伝票は承認ずみではありません"
38： End If
39：
40： ' 権限の確認
41： If Not objContext.IsSecurityEnabled() Then
42： ' セキュリティ設定が無効
43： Err.Raise ERR_NOSECURE, App.Title, _
"セキュリティ機構が無効です"
44： End If
45：
46： ' 現在の伝票の情報を取得
47： objDataSlip.GetRecord_Slip SlipID, old_CUSTOMERID, _
old_SUBTOTAL, old_TAX, old_TOTAL, _
old_MADEDATE, old_MADEUSER, _
old_LASTDATE, old_LASTUSER
48：
49： ' 承認したユーザー情報を取得
50： objDataSlip.GetRecord_Consented SlipID, CONSENTEDUSER, _
CONSENTEDDATE, CONSENTEDCOMMENT
51：
52： ' 起票者または承認したユーザーであるか
53： If Not (objContext.Security.GetOriginalCallerName() = old_MADEUSER Or _
objContext.Security.GetOriginalCallerName() = CONSENTEDUSER) Then
54： ' 一致しない
55： ' SalesAdminロール，AllAdminロールに属する
56： ' のであれば，一致しなくてもよいものとする
57： If Not (objContext.IsCallerInRole("SalesAdmin") Or _
objContext.IsCallerInRole("AllAdmin")) Then
58： ' SalesAdminロール，AllAdminロールに属さない
59： Err.Raise ERR_NOSECURE, App.Title, _
"他人が承認した伝票を元に戻すことはできません"
60： End If
61： End If
62：
63： ' CONSENTEDFLAGフィールドの値をFalseにする
64： objDataSlip.Set_CONSENTEDFLAG SlipID, False, Null
65： ' REQ_CONSENTFLAGフィールドの値をTrueにする
66： objDataSlip.GetRecord_Request SlipID, old_REQUSER, _
old_REQDATE, old_REQCOMMENT
67： objDataSlip.Set_REQ_CONSENTFLAG SlipID, True, old_REQCOMMENT
68：
69： ' 在庫情報テーブルに加えた出庫を示すレコードを削除する
70： ' この伝票から作られた出庫予定レコードを取得
71： ' DataObj.Stockコンポーネントの実体化
72： Set objDataStock = CreateObject("DataObj.Stock")
73： Set objRecStock = objDataStock.GetRecordsBySlipID(SlipID)
74：
75： While Not objRecStock.EOF
76： ' 在庫情報テーブルの出庫予定レコードを削除する
77： objDataStock.DeleteRecord objRecStock.Fields("ID").Value
78： ' 次のレコードに移動
79： objRecStock.MoveNext
80： Wend
81：
82： objRecStock.Close
83： Set objRecStock = Nothing
84：
85： ' 各種コンポーネントの解放
86： Set objDataStock = Nothing
87： Set objDataSlip = Nothing
88：
89： ' コミットする
90： objContext.SetComplete
91：
92： ' オブジェクトコンテキストの解放
93： Set objContext = Nothing
94：
95： Exit Sub
96：
97： ErrHandle:
98： ' エラーハンドラ
99： objContext.SetAbort
100： Set objDataSlip = Nothing
101： Set objDataStock = Nothing
102： Set objRecStock = Nothing
103：
104： ' エラーの再発行
105： Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
106： End Sub