List 6-147　DataObj.SlipコンポーネントのSet_MADEBILLFLAGメソッド

  1： Public Sub Set_MADEBILLFLAG(ByVal SlipID As Long, _
   　                             ByVal flag As Boolean)
  2：     ' 指定された伝票のMADEBILLFLAGフィールドの値を変更する
  3：     ' 【引数】
  4：     '   SlipID = 変更したい伝票の伝票番号
  5：     '   flag = 変更後のMADEBILLFLAGフィールドの値
  6：     ' 【戻り値】
  7：     ' なし
  8：     Dim objContext As ObjectContext
  9：     Dim objRec As ADODB.Recordset
 10：     Dim userName As Variant, NowDate As Variant
 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 * FROM 伝票情報 WHERE ID=" & SlipID, _
   　                 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：     objRec.Fields("LASTUSER").Value = userName
 36：     objRec.Fields("LASTDATE").Value = NowDate
 37：     
 38：     If objRec.Fields("MADEBILLFLAG").Value <> flag Then
 39：         objHistory.AddHistory "伝票情報", "MADEBILLFLAG", SlipID, _
   　                               objRec.Fields("MADEBILLFLAG").Value, flag
 40：         objRec.Fields("MADEBILLFLAG").Value = flag
 41：         If flag = True Then
 42：             objHistory.AddHistory "伝票情報", "BILLDATE", SlipID, _
   　                                   objRec.Fields("BILLDATE").Value, NowDate
 43：             objRec.Fields("BILLDATE").Value = NowDate
 44：         End If
 45：     End If
 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 Sub
 63：     
 64： ErrHandle:
 65：     ' エラーハンドラ
 66：     objContext.SetAbort
 67：     
 68：     Set objContext = Nothing
 69：     Set objRec = Nothing
 70：     Set objHistory = Nothing
 71：     
 72：     ' エラーの再発行
 73：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 74： End Sub