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