List 6-190　DataObj.BillコンポーネントのSet_PAIDFLAGメソッド

  1： Public Sub Set_PAIDFLAG(ByVal BillID As Long, _
   　                         ByVal flag As Boolean, _
   　                         ByVal Comment As Variant)
  2：     ' 指定された請求書のPAIDFLAGフィールドの値を変更する
  3：     ' 【引数】
  4：     '   BillID = 変更したい請求書の請求書番号
  5：     '   flag = 設定するPAIDFLAGフィールドの値
  6：     '   Comment = 設定時のコメント（flagがTrueのときのみ有効）
  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：     If Not IsNull(Comment) Then
 29：         If Len(Comment) > 80 Then
 30：             Err.Raise Errorcode.Err_MEMOTOOLONG, App.Title, _
   　                       "コメントが長すぎます"
 31：         End If
 32：     End If
 33：     
 34：     ' データベースと接続し，指定された請求書の情報を更新
 35：     Set objRec = CreateObject("ADODB.Recordset")
 36：     objRec.Open "SELECT * FROM 請求書情報 WHERE ID=" & BillID, _
   　                  g_DBConnection, adOpenKeyset, adLockPessimistic, adCmdText
 37：                  
 38：     If objRec.EOF Then
 39：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
   　                   "指定された請求書番号を持つ請求書が見つかりません"
 40：     End If
 41：     
 42：     ' レコードの値を更新
 43：     objRec.Fields("LASTUSER").Value = userName
 44：     objRec.Fields("LASTDATE").Value = NowDate
 45：     
 46：     If objRec.Fields("PAIDFLAG").Value <> flag Then
 47：         objHistory.AddHistory "請求書情報", "PAIDFLAG", _
   　                               BillID, objRec.Fields("PAIDFLAG").Value, flag
 48：         objRec.Fields("PAIDFLAG").Value = flag
 49：         If flag = True Then
 50：             objHistory.AddHistory "請求書情報", "SUBMITUSER", _
   　                                   BillID, objRec.Fields("SUBMITUSER").Value, userName
 51：             objRec.Fields("SUBMITUSER").Value = userName
 52：             objHistory.AddHistory "請求書情報", "SUBMITDATE", _
   　                                   BillID, objRec.Fields("SUBMITDATE").Value, NowDate
 53：             objRec.Fields("SUBMITDATE").Value = NowDate
 54：             objHistory.AddHistory "請求書情報", "MEMO", _
   　                                   BillID, objRec.Fields("MEMO").Value, Comment
 55：             objRec.Fields("MEMO").Value = Comment
 56：         End If
 57：     End If
 58：     
 59：     objRec.Update
 60：     
 61：     ' データベースとの接続を閉じてレコードセットを解放
 62：     objRec.Close
 63：     Set objRec = Nothing
 64：     
 65：     ' DataObj.Historyオブジェクトの解放
 66：     Set objHistory = Nothing
 67：     
 68：     ' トランザクションのコミット
 69：     objContext.SetComplete
 70：     
 71：     ' オブジェクトコンテキストの解放
 72：     Set objContext = Nothing
 73：     
 74：     Exit Sub
 75： 
 76： ErrHandle:
 77：     ' エラーハンドラ
 78：     objContext.SetAbort
 79：     
 80：     Set objContext = Nothing
 81：     Set objRec = Nothing
 82：     Set objHistory = Nothing
 83：     
 84：     ' エラーの再発行
 85：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 86： End Sub