List 6-76　DataObj.ProductコンポーネントのAddStockメソッド

  1： Public Sub AddStock(ByVal ProductID As Long, ByVal NUMBER As Long)
  2：     ' 製品情報テーブル内の指定された製品の在庫数（STOCKフィールドの値）
  3：     ' を指定された数だけ増やす（負の数が渡されたときには減らす）
  4：     ' 【引数】
  5：     '   ProductID = 在庫数の増加の対象となる製品を特定する製品番号
  6：     '   Number = 在庫を増やす数量（負のときは在庫の減少を示す）
  7：     ' 【戻り値】
  8：     '   なし
  9：     Dim objContext As ObjectContext
 10：     Dim objRec As ADODB.Recordset
 11：     Dim userName As String, NowDate As Date
 12：     Dim objHistory As DataObj.History
 13：     Dim NewStock As Long
 14：     
 15：     ' オブジェクトコンテキストの取得
 16：     Set objContext = GetObjectContext()
 17：     
 18：     ' エラーハンドラの設定
 19：     On Error GoTo ErrHandle
 20：     
 21：     ' DataObj.Historyコンポーネントの実体化
 22：     Set objHistory = CreateObject("DataObj.History")
 23：     
 24：     ' ユーザー名と現在の時刻を取得
 25：     userName = objContext.Security.GetOriginalCallerName()
 26：     NowDate = Now()
 27：     
 28：     ' データベースと接続して，指定された製品の在庫数を更新する
 29：     Set objRec = CreateObject("ADODB.Recordset")
 30：     objRec.Open "SELECT STOCK, LASTUSER, LASTDATE FROM 製品情報 WHERE ID=" & _
   　                  ProductID & " AND DELETEDFLAG=0", _
   　                  g_DBConnection, adOpenKeyset, adLockPessimistic, adCmdText
 31：     
 32：     If objRec.EOF Then
 33：         Err.Raise Errorcode.Err_NotFound, App.Title, _
   　                   "指定された製品番号を持つ製品が見つかりません"
 34：     End If
 35：     
 36：     ' レコードの値を更新
 37：     NewStock = objRec.Fields("STOCK").Value + NUMBER
 38：     objHistory.AddHistory "製品情報", "STOCK", ProductID, _
   　                           objRec.Fields("STOCK").Value, NewStock
 39：     objRec.Fields("STOCK").Value = NewStock
 40：     
 41：     objRec.Fields("LASTUSER").Value = userName
 42：     objRec.Fields("LASTDATE").Value = NowDate
 43：     objRec.Update
 44：     
 45：     ' データベースとの接続を閉じてレコードセットを解放
 46：     objRec.Close
 47：     Set objRec = Nothing
 48：     
 49：     ' DataObj.Historyオブジェクトを解放する
 50：     Set objHistory = Nothing
 51：     
 52：     ' コミットする
 53：     objContext.SetComplete
 54：     
 55：     ' オブジェクトコンテキストの解放
 56：     Set objContext = Nothing
 57：     
 58：     Exit Sub
 59：     
 60： ErrHandle:
 61：     ' エラーハンドラ
 62：     objContext.SetAbort
 63：     Set objContext = Nothing
 64：     Set objRec = Nothing
 65：     Set objHistory = Nothing
 66：     
 67：     ' エラーの再発行
 68：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 69： End Sub