List 6-31　DataObj.CustomerコンポーネントのSetDeletedFlagメソッド

  1： Public Sub SetDeletedFlag(ByVal CustomerID As Long, ByVal DELETEDFLAG As Boolean)
  2：     ' 顧客情報テーブルの指定された顧客のDELETEDFLAGフィールドの値を変更する
  3：     ' 【引数】
  4：     '   CustomerID = 削除したい顧客の顧客番号
  5：     '   DELETEDFLAG = 設定するDELETEDFLAGフィールドの値
  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：     
 13：     ' オブジェクトコンテキストの取得
 14：     Set objContext = GetObjectContext()
 15：     
 16：     ' エラーハンドラの設定
 17：     On Error GoTo ErrHandle
 18：     
 19：     ' DataObj.Historyコンポーネントの実体化
 20：     Set objHistory = CreateObject("DataObj.History")
 21：     
 22：     ' ユーザー名と現在の時刻を取得
 23：     userName = objContext.Security.GetOriginalCallerName()
 24：     NowDate = Now()
 25：     
 26：     ' データベースと接続して，書き込み可能なレコードセットを得る
 27：     Set objRec = CreateObject("ADODB.Recordset")
 28：     objRec.Open "SELECT LASTUSER, LASTDATE, DELETEDFLAG FROM 顧客情報 WHERE ID=" & _
   　                 CustomerID, g_DBConnection, adOpenKeyset, _
   　                 adLockPessimistic, adCmdText
 29：                 
 30：     If objRec.EOF Then
 31：         Err.Raise Errorcode.Err_NotFound, App.Title, _
   　                   "指定された顧客番号をもつ顧客が見つかりません"
 32：     End If
 33：                 
 34：     ' レコードの値を更新
 35：     If objRec.Fields("DELETEDFLAG").Value <> DELETEDFLAG Then
 36：         objHistory.AddHistory "顧客情報", "DELETEDFLAG", _
   　                               CustomerID, objRec.Fields("DELETEDFLAG").Value, _
   　                               DELETEDFLAG
 37：         objRec.Fields("DELETEDFLAG").Value = DELETEDFLAG
 38：     End If
 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：     Set objContext = Nothing
 63：     Set objRec = Nothing
 64：     Set objHistory = Nothing
 65：     
 66：     ' エラーの再発行
 67：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 68： End Sub