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

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