List 6-80 DataObj.StockコンポーネントのUpdateRecordメソッド
1: Public Sub UpdateRecord(ByVal StockID As Variant, _
ByVal WillDate As Variant, _
ByVal ProductID As Variant, _
ByVal NUMBER As Variant, _
ByVal MEMO As Variant, _
ByVal SlipID As Variant)
2: ' 在庫情報テーブルの指定されたレコードを更新する
3: ' 【引数】
4: ' StockID = 設定したいレコードを特定するレコードID(IDフィールドの値)
5: ' WillDate = 入庫や出庫の予定日
6: ' ProductID = 入庫や出庫となる製品を特定する製品番号
7: ' Number = 入庫または出庫数
8: ' MEMO = 摘要
9: ' SLIPID = この出庫と関連づけられる伝票の伝票番号
10: ' (入庫のときにはNull)
11: ' 【戻り値】なし
12: Dim objContext As ObjectContext
13: Dim objRec As ADODB.Recordset
14: Dim userName As String, nowdate As Date
15: Dim objHistory As DataObj.History
16:
17: ' オブジェクトコンテキストの取得
18: Set objContext = GetObjectContext()
19:
20: ' エラーハンドラの設定
21: On Error GoTo ErrHandle
22:
23: ' DataObj.Historyコンポーネントの実体化
24: Set objHistory = CreateObject("DataObj.History")
25:
26: ' ユーザー名と現在の時刻を取得
27: userName = objContext.Security.GetOriginalCallerName()
28: nowdate = Now()
29:
30: ' 与えられた引数が正しいかどうかをチェック
31: Chk_WillDate WillDate
32: Chk_ProductID ProductID
33: Chk_Number NUMBER
34: Chk_MEMO MEMO
35: Chk_SlipID SlipID
36:
37: ' データベースと接続して,指定されたレコードの情報を更新する
38: Set objRec = CreateObject("ADODB.Recordset")
39: objRec.Open "SELECT * FROM 在庫情報 WHERE ID=" & StockID, _
g_DBConnection, adOpenKeyset, adLockPessimistic, adCmdText
40:
41: If objRec.EOF Then
42: Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
"指定された入庫予定または出庫予定は見つかりません"
43: End If
44:
45: ' レコードの値を更新
46: If objRec.Fields("DATE").Value <> WillDate Or _
(IsNull(objRec.Fields("DATE").Value) Xor IsNull(WillDate)) Then
47: objHistory.AddHistory "在庫情報", "DATE", StockID, _
objRec.Fields("DATE").Value, WillDate
48: objRec.Fields("DATE").Value = WillDate
49: End If
50: If objRec.Fields("PRODUCTID").Value <> ProductID Or _
(IsNull(objRec.Fields("PRODUCTID").Value) Xor IsNull(ProductID)) Then
51: objHistory.AddHistory "在庫情報", "PRODUCTID", StockID, _
objRec.Fields("PRODUCTID").Value, ProductID
52: objRec.Fields("PRODUCTID").Value = ProductID
53: End If
54: If objRec.Fields("NUMBER").Value <> NUMBER Or _
(IsNull(objRec.Fields("NUMBER").Value) Xor IsNull(NUMBER)) Then
55: objHistory.AddHistory "在庫情報", "NUMBER", StockID, _
objRec.Fields("NUMBER").Value, NUMBER
56: objRec.Fields("NUMBER").Value = NUMBER
57: End If
58: If objRec.Fields("MEMO").Value <> MEMO Or _
(IsNull(objRec.Fields("MEMO").Value) Xor IsNull(MEMO)) Then
59: objHistory.AddHistory "在庫情報", "MEMO", StockID, _
objRec.Fields("MEMO").Value, MEMO
60: objRec.Fields("MEMO").Value = MEMO
61: End If
62: If objRec.Fields("SLIPID").Value <> SlipID Or _
(IsNull(objRec.Fields("SLIPID").Value) Xor IsNull(SlipID)) Then
63: objHistory.AddHistory "在庫情報", "SLIPID", StockID, _
objRec.Fields("SLIPID").Value, SlipID
64: objRec.Fields("SLIPID").Value = SlipID
65: End If
66:
67: objRec.Fields("LASTUSER").Value = userName
68: objRec.Fields("LASTDATE").Value = nowdate
69: objRec.Update
70:
71: ' データベースとの接続を閉じてレコードセットを解放
72: objRec.Close
73: Set objRec = Nothing
74:
75: ' DataObj.Historyオブジェクトを解放する
76: Set objHistory = Nothing
77:
78: ' コミットする
79: objContext.SetComplete
80:
81: ' オブジェクトコンテキストの解放
82: Set objContext = Nothing
83:
84: Exit Sub
85:
86: ErrHandle:
87: ' エラーハンドラ
88: objContext.SetAbort
89:
90: Set objContext = Nothing
91: Set objRec = Nothing
92: Set objHistory = Nothing
93:
94: ' エラーの再発行
95: Err.Raise Err.NUMBER, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
96: End Sub