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