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

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