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

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