List 6-72　DataObj.StockコンポーネントのSetConfirmedFlagメソッド

  1： Public Sub SetConfirmedFlag(ByVal StockID As Long, _
   　                             ByVal CONFIRMEDFLAG As Boolean)
  2：     ' 在庫情報テーブル中の指定されたレコードの
  3：     ' CONFIRMEDFLAGフィールドの値を変更する
  4：     ' 【引数】
  5：     '   StockID = 変更するレコードを特定するレコードID（IDフィールドの値）
  6：     '   ConfirmedFlag = 設定するCONFIRMEDFLAGフィールドの値
  7：     ' 【戻り値】
  8：     '   なし
  9：     Dim objContext As ObjectContext
 10：     Dim objRec As ADODB.Recordset
 11：     Dim userName As String, NowDate As Variant
 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, CONFIRMEDFLAG, " & _
   　                 "DUEDATE FROM 在庫情報 WHERE ID=" & _
   　                 StockID & " AND DELETEDFLAG=0", 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("CONFIRMEDFLAG").Value <> CONFIRMEDFLAG Then
 37：         objHistory.AddHistory "在庫情報", "CONFIRMEDFLAG", StockID, _
   　                               objRec.Fields("CONFIRMEDFLAG").Value, _
   　                               CONFIRMEDFLAG
 38：         objRec.Fields("CONFIRMEDFLAG").Value = CONFIRMEDFLAG
 39：         If CONFIRMEDFLAG Then
 40：             objHistory.AddHistory "在庫情報", "DUEDATE", StockID, _
   　                                   objRec.Fields("DUEDATE").Value, NowDate
 41：             objRec.Fields("DUEDATE").Value = NowDate
 42：         Else
 43：             objHistory.AddHistory "在庫情報", "DUEDATE", StockID, _
   　                                   objRec.Fields("DUEDATE").Value, Null
 44：             objRec.Fields("DUEDATE").Value = Null
 45：         End If
 46：     End If
 47：     
 48：     objRec.Fields("LASTUSER").Value = userName
 49：     objRec.Fields("LASTDATE").Value = NowDate
 50：     objRec.Update
 51：     
 52：     ' データベースとの接続を閉じてレコードセットを解放
 53：     objRec.Close
 54：     Set objRec = Nothing
 55：     
 56：     ' DataObj.Historyオブジェクトを解放する
 57：     Set objHistory = Nothing
 58：     
 59：     ' コミットする
 60：     objContext.SetComplete
 61：     
 62：     ' オブジェクトコンテキストの解放
 63：     Set objContext = Nothing
 64： 
 65：     Exit Sub
 66：     
 67： ErrHandle:
 68：     ' エラーハンドラ
 69：     objContext.SetAbort
 70：     Set objContext = Nothing
 71：     Set objRec = Nothing
 72：     Set objHistory = Nothing
 73：     
 74：     ' エラーの再発行
 75：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 76： End Sub