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

  1： Private Sub Chk_Comment(Comment As Variant)
  2：     ' コメントが正しいかどうかを調べる
  3：     If Not IsNull(Comment) Then
  4：         If Len(Comment) > 80 Then
  5：             Err.Raise Errorcode.Err_MEMOTOOLONG, App.Title, _
  6：                       "コメントが長すぎます"
  7：         End If
  8：     End If
  9： End Sub
 10： 
 11： Public Sub Set_REQ_CONSENTFLAG(ByVal SlipID As Long, _
   　                                ByVal flag As Boolean, _
   　                                ByVal Comment As Variant)
 12：     ' 指定された伝票のREQ_CONSENTFLAGフィールドの値を変更する
 13：     ' 【引数】
 14：     '   SlipID = 変更したい伝票の伝票番号
 15：     '   flag = 変更後のREQ_CONSENTFLAGフィールドの値
 17：     '   Comment = 変更時のコメント（flagがTrueのときのみ有効）
 18：     ' 【戻り値】
 19：     ' なし
 20：     Dim objContext As ObjectContext
 21：     Dim objRec As ADODB.Recordset
 22：     Dim userName As Variant, NowDate As Variant
 23：     Dim objHistory As DataObj.History
 24：     
 25：     ' オブジェクトコンテキストの取得
 26：     Set objContext = GetObjectContext()
 27：     
 28：     ' エラーハンドラの設定
 29：     On Error GoTo ErrHandle
 30：     
 31：     ' DataObj.Historyコンポーネントの実体化
 32：     Set objHistory = CreateObject("DataObj.History")
 33：     
 34：     ' ユーザー名とその時点の時刻を取得
 35：     userName = objContext.Security.GetOriginalCallerName()
 36：     NowDate = Now()
 37：     
 38：     ' 与えられた引数が正しいかどうかをチェック
 39：     Chk_Comment Comment
 40：     
 41：     ' データベースと接続して，指定された伝票の伝票情報を更新
 42：     Set objRec = CreateObject("ADODB.Recordset")
 43：     objRec.Open "SELECT * FROM 伝票情報 WHERE ID=" & SlipID, _
   　                 g_DBConnection, adOpenKeyset, adLockPessimistic,adCmdText
 44：                 
 45：     If objRec.EOF Then
 46：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
   　                   "指定された伝票番号を持つ伝票が見つかりません"
 47：     End If
 48：     
 49：     ' レコードの値を更新
 50：     objRec.Fields("LASTUSER").Value = userName
 51：     objRec.Fields("LASTDATE").Value = NowDate
 52：     
 53：     If objRec.Fields("REQ_CONSENTFLAG").Value <> flag Then
 54：         objHistory.AddHistory "伝票情報", "REQ_CONSENTFLAG", SlipID, _
   　                               objRec.Fields("REQ_CONSENTFLAG").Value, flag
 55：         objRec.Fields("REQ_CONSENTFLAG").Value = flag
 56：         If flag = True Then
 57：             objHistory.AddHistory "伝票情報", "REQ_CONSENTUSER", SlipID, _
   　                                   objRec.Fields("REQ_CONSENTUSER").Value, userName
 58：             objRec.Fields("REQ_CONSENTUSER").Value = userName
 59：             objHistory.AddHistory "伝票情報", "REQ_CONSENTDATE", SlipID, _
   　                                   objRec.Fields("REQ_CONSENTDATE").Value, NowDate
 60：             objRec.Fields("REQ_CONSENTDATE").Value = NowDate
 61：             objHistory.AddHistory "伝票情報", "REQ_CONSENTCOMMENT", SlipID, _
   　                                   objRec.Fields("REQ_CONSENTCOMMENT").Value, Comment
 62：             objRec.Fields("REQ_CONSENTCOMMENT").Value = Comment
 63：         End If
 64：     End If
 65：     
 66：     objRec.Update
 67：     
 68：     ' データベースとの接続を閉じてレコードセットを解放
 69：     objRec.Close
 70：     Set objRec = Nothing
 71：     
 72：     ' DataObj.Historyオブジェクトの解放
 73：     Set objHistory = Nothing
 74：     
 75：     ' トランザクションのコミット
 76：     objContext.SetComplete
 77：     
 78：     ' オブジェクトコンテキストの解放
 79：     Set objContext = Nothing
 80：     
 81：     Exit Sub
 82：     
 83： ErrHandle:
 84：     ' エラーハンドラ
 85：     objContext.SetAbort
 86：     
 87：     Set objContext = Nothing
 88：     Set objRec = Nothing
 89：     Set objHistory = Nothing
 90：     
 91：     ' エラーの再発行
 92：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 93： End Sub