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

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