List 6-107　DataObj.SlipInformationコンポーネントのSetDeletedメソッド

  1： Public Sub SetDeleted(ByVal ID As Long)
  2：     ' 伝票追加情報テーブル中の指定されたレコードIDと一致する
  3：     ' レコードのDELETEDFLAGフィールドをTrueにする
  4：     ' 【引数】
  5：     '   ID = DELETEDFLAGフィールドの値をTrueにしたいレコードを
  6：     '        特定するレコードID（IDフィールドの値）
  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：     
 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 LASTUSER, LASTDATE, DELETEDFLAG FROM 伝票追加情報 WHERE ID=" &　ID, _
   　                 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：     If objRec.Fields("DELETEDFLAG").Value = False Then
 37：         objHistory.AddHistory "伝票追加情報", "DELETEDFLAG", _
   　                               ID, objRec.Fields("DELETEDFLAG").Value, True
 38：         objRec.Fields("DELETEDFLAG").Value = True
 39：     End If
 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：     
 64：     Set objContext = Nothing
 65：     Set objRec = Nothing
 66：     Set objHistory = Nothing
 67：     
 68：     ' エラーの再発行
 69：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 70： End Sub