List 6-195 DataObj.BillコンポーネントのSetDeletedFlagメソッド
  1: Public Sub SetDeletedFlag(ByVal BillID As Long, _
                               ByVal DELETEDFLAG As Boolean)
  2:     ' 請求書情報テーブルの指定された請求書のDELETEDFLAGフィールドの値を変更する
  3:     ' 【引数】
  4:     '   BillID = DELETEDFLAGフィールドの値を変更したい請求書の請求書番号
  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=" & BillID, _
                     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", BillID, _
                                   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