List 6-166 Business.SlipコンポーネントのCancelSendSlipメソッド
1: Public Sub CancelSendSlip(ByVal SlipID)
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 objDataProduct As DataObj.Product
11: Dim objRec As ADODB.Recordset
12: Dim SlipStatus As SlipStatus
13: Dim old_SENDUSER As Variant, old_SENDDATE As Variant
14: Dim old_SENDCOMMENT As Variant
15: Dim old_CONSENTEDUSER As Variant, old_CONSENTEDDATE As Variant
16: Dim old_CONSENTEDCOMMENT 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 <> Send) 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_Send SlipID, old_SENDUSER, old_SENDDATE, old_SENDCOMMENT
48: ' 発送ずみにしたユーザーと呼び出したユーザーが一致するか
49: If objContext.Security.GetOriginalCallerName() <> old_SENDUSER Then
50: ' 一致しない
51: ' ProductsAdminロールまたはAllAdminロールに属するのであれば,
52: ' 一致しなくてもよいものとする
53: If Not (objContext.IsCallerInRole("ProductsAdmin") Or _
objContext.IsCallerInRole("AllAdmin")) Then
54: ' ProductsAdminロールまたはAllAdminロールに属さない
55: Err.Raise ERR_NOSECURE, App.Title, _
"他人が発送ずみにした伝票を元に戻すことはできません"
56: End If
57: End If
58:
59: ' SENDFLAGフィールドの値をFalseにする
60: objDataSlip.Set_SENDFLAG SlipID, False, Null
61: ' CONSENTEDFLAGフィールドの値をTrueにする
62: objDataSlip.GetRecord_Consented SlipID, old_CONSENTEDUSER, _
old_CONSENTEDDATE, old_CONSENTEDCOMMENT
63: objDataSlip.Set_CONSENTEDFLAG SlipID, True, old_CONSENTEDCOMMENT
64:
65: ' DataObj.Stockコンポーネントの実体化
66: Set objDataStock = CreateObject("DataObj.Stock")
67: ' DataObj.Productコンポーネントの実体化
68: Set objDataProduct = CreateObject("DataObj.Product")
69:
70: ' この伝票が生じた出庫予定レコードを取得
71: Set objRec = objDataStock.GetRecordsBySlipID(SlipID)
72:
73: ' すべての出庫予定に対してループ
74: While Not objRec.EOF
75: ' 出庫予定レコードを施行まえに戻す
76: objDataStock.SetConfirmedFlag objRec.Fields("ID").Value, False
77: ' 在庫数を増やす
78: '(NUMBERフィールドには負の数が入っている点に注意)
79: objDataProduct.AddStock objRec.Fields("PRODUCTID").Value, _
-objRec.Fields("NUMBER").Value
80: ' 予約数を増やす
81: '(NUMBERフィールドには負の数が入っている点に注意)
82: objDataProduct.AddBackOrder objRec.Fields("PRODUCTID").Value, _
-objRec.Fields("NUMBER").Value
83:
84: ' 次のレコードに移動
85: objRec.MoveNext
86: Wend
87:
88: objRec.Close
89: Set objRec = Nothing
90:
91: ' 各種コンポーネントの解放
92: Set objDataProduct = Nothing
93: Set objDataStock = Nothing
94: Set objDataSlip = Nothing
95:
96: ' トランザクションのコミット
97: objContext.SetComplete
98:
99: ' オブジェクトコンテキストの解放
100: Set objContext = Nothing
101:
102: Exit Sub
103:
104: ErrHandle:
105: ' エラーハンドラ
106: objContext.SetAbort
107: Set objDataSlip = Nothing
108: Set objDataStock = Nothing
109: Set objDataProduct = Nothing
110: Set objRec = Nothing
111:
112: ' エラーの再発行
113: Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
114: End Sub