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

  1： Public Function SetDeleted(ByVal ID As Long) 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, SLIPID" & _
   　                 " 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：     
 44：     ' 伝票番号を戻り値に設定
 45：     SetDeleted = objRec.Fields("SLIPID").Value
 46：     
 47：     objRec.Update
 48：     
 49：     ' データベースとの接続を閉じてレコードセットを解放
 50：     objRec.Close
 51：     Set objRec = Nothing
 52：     
 53：     ' DataObj.Historyオブジェクトの解放
 54：     Set objHistory = Nothing
 55：     
 56：     ' トランザクションをコミット
 57：     objContext.SetComplete
 58：     
 59：     ' オブジェクトコンテキストの解放
 60：     Set objContext = Nothing
 61： 
 62：     Exit Function
 63：     
 64： ErrHandle:
 65：     ' エラーハンドラ
 66：     objContext.SetAbort
 67：     
 68：     Set objContext = Nothing
 69：     Set objRec = Nothing
 70：     Set objHistory = Nothing
 71：     
 72：     SetDeleted = -1
 73：     
 74：     ' エラーの再発行
 75：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 76： End Function