List 6-77 Business.ProductコンポーネントのSetDueメソッド
1: Public Sub SetDue(ByVal StockID As Long)
2: ' 指定された入庫予定を施行ずみにする
3: ' 【引数】
4: ' StockID = 在庫情報テーブル中の入庫予定を
5: ' 特定するレコードID(IDフィールドの値)
6: ' 【戻り値】
7: ' なし
8: Dim objContext As ObjectContext
9: Dim objDataProduct As DataObj.Product
10: Dim objDataStock As DataObj.STOCK
11: Dim WillDate As Variant, DUEDATE As Variant, CONFIRMEDFLAG As Variant
12: Dim PRODUCTID As Variant, NUMBER As Variant, MEMO As Variant
13: Dim SLIPID As Variant, MADEUSER As Variant, MADEDATE As Variant
14: Dim LASTUSER As Variant, LASTDATE As Variant
15:
16: ' オブジェクトコンテキストの取得
17: Set objContext = GetObjectContext()
18:
19: ' エラーハンドラの設定
20: On Error GoTo ErrHandle
21:
22: ' DataObj.Productコンポーネントの実体化
23: Set objDataProduct = CreateObject("DataObj.Product")
24: ' DataObj.Stockコンポーネントの実体化
25: Set objDataStock = CreateObject("DataObj.Stock")
26:
27: ' まだ施行されていないことを確認
28: If objDataStock.IsDue(StockID) <> STOCK_NODUE Then
29: Err.Raise Errorcode.Err_NotFound, App.Title, _
"指定された入庫予定が見つからないかすでに施行ずみです"
30: End If
31:
32: ' 施行ずみに設定する
33: objDataStock.SetConfirmedFlag StockID, True
34:
35: ' 現在のレコードの値を取得
36: objDataStock.GetRecord StockID, WillDate, DUEDATE, CONFIRMEDFLAG, _
PRODUCTID, NUMBER, MEMO, SLIPID, _
MADEUSER, MADEDATE, LASTUSER, LASTDATE
37:
38: ' 出庫予定ではないことを確認
39: If Not IsNull(SLIPID) Then
40: ' これは出庫用のレコード
41: Err.Raise BusinessError.ERR_CANTACCESS, App.Title, _
"出庫予定を操作することはできません"
42: End If
43:
44: ' 在庫に入庫数を加える
45: objDataProduct.AddStock PRODUCTID, NUMBER
46:
47: ' DataObj.Stockの解放
48: Set objDataStock = Nothing
49: ' DataObj.Productの解放
50: Set objDataProduct = Nothing
51:
52: Exit Sub
53:
54: ErrHandle:
55: ' エラーハンドラ
56: objContext.SetAbort
57: Set objContext = Nothing
58: Set objDataProduct = Nothing
59: Set objDataStock = Nothing
60:
61: ' エラーの再発行
62: Err.Raise Err.NUMBER, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
63: End Sub