List 6-164　変更したBusiness.SlipコンポーネントのConsentSlipメソッド（変更部分は赤色で示した）

  1： Public Sub ConsentSlip(ByVal SlipID As Long, _
   　                        ByVal Comment As Variant)
  2：     ' 指定された伝票を承認ずみにする
  3：     ' 【引数】
  4：     '   SlipID = 承認ずみとしたい伝票の伝票番号
  5：     '   Comment = 承認ずみにするときのコメント
  6：     ' 【戻り値】
  7：     '   なし
  8：     Dim objContext As ObjectContext
  9：     Dim objDataSlip As DataObj.Slip
 10：     Dim objDataSlipDetail As DataObj.SlipDetail
 11：     Dim objDataSlipInformation As DataObj.SlipInformation
 12：     Dim objDataStock As DataObj.STOCK
 13：     Dim objRecSlipDetail As ADODB.Recordset
 14：     Dim SlipStatus As SlipStatus
 15：     Dim old_MADEDATE As Variant, old_MADEUSER As Variant
 16：     Dim old_LASTUSER As Variant, old_LASTDATE As Variant
 17：     Dim old_DIVISION As Variant, old_PERSON As Variant, old_DELIVERDATE As Variant
 18：     Dim old_SENT_ADDR As Variant, old_SENT_TEL As Variant, old_MEMO As Variant
 19：     Dim old_CUSTOMERID As Variant, old_SUBTOTAL As Variant, old_TAX As Variant
 20：     Dim old_TOTAL As Variant
 21： 
 22：     ' オブジェクトコンテキストの取得
 23：     Set objContext = GetObjectContext()
 24：     
 25：     ' エラーハンドラの設定
 26：     On Error GoTo ErrHandle
 27：     
 28：     ' DataObj.Slipコンポーネントを実体化
 29：     Set objDataSlip = CreateObject("DataObj.Slip")
 30：     
 31：     ' 伝票が存在することを確認
 32：     If objDataSlip.IsDeleted(SlipID) <> ID_Exists Then
 33：         ' 伝票が存在しない
 34：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
 35：                   "指定された伝票は存在しません"
 36：     End If
 37：     
 38：     ' 伝票の状態を取得
 39：     SlipStatus = objDataSlip.Get_SlipStatus(SlipID)
 40：     If (SlipStatus <> RequestingConsent) Then
 41：         ' 伝票が承認依頼中ではない
 42：         Err.Raise BusinessError.Err_CANTUPDATE, App.Title, _
   　                   "その伝票は承認依頼中ではありません"
 43：     End If
 44：     
 45：     ' 権限の確認
 46：     If Not objContext.IsSecurityEnabled() Then
 47：         ' セキュリティ設定が無効
 48：         Err.Raise ERR_NOSECURE, App.Title, _
   　                   "セキュリティ機構が無効です"
 49：     End If
 50：     ' 伝票の状態を取得
 51：     objDataSlip.GetRecord_Slip SlipID, old_CUSTOMERID, _
   　                                old_SUBTOTAL, old_TAX, _
   　                                old_TOTAL, old_MADEDATE, _
   　                                old_MADEUSER, old_LASTDATE, _
   　                                old_LASTUSER
 52：     If (objContext.Security.GetOriginalCallerName <> old_MADEUSER) Or _
   　        (old_TOTAL > g_MaxTotal) Then
 53： 
 54：         If Not (objContext.IsCallerInRole("SalesManager") Or _
   　                 objContext.IsCallerInRole("SalesAdmin") Or _
   　                 objContext.IsCallerInRole("AllAdmin")) Then
   　             ' SalesManager，SalesAdmin，AllAdminのいずれのロールにも属さない
 55：             Err.Raise ERR_NOSECURE, App.Title, _
   　                       "承認ずみにする権限がありません"
 56：         End If
 57：     End If
 58： 
 59：     ' CONSENTEDFLAGフィールドの値をTrueにする
 60：     objDataSlip.Set_CONSENTEDFLAG SlipID, True, Comment
 61：     ' REQ_CONSENTFLAGフィールドの値をFalseにする
 62：     objDataSlip.Set_REQ_CONSENTFLAG SlipID, False, Null
 63：     
 64：     ' 伝票追加情報を取得し，納入予定日を得る
 65：     ' DataObj.SlipInformationコンポーネントの実体化
 66：     Set objDataSlipInformation = CreateObject("DataObj.SlipInformation")
 67：     objDataSlipInformation.GetRecord SlipID, old_DIVISION, _
   　                                      old_PERSON, old_DELIVERDATE, _
   　                                      old_SENT_ADDR, old_SENT_TEL, old_MEMO, _
   　                                      old_MADEDATE, old_MADEUSER, _
   　                                      old_LASTDATE, old_LASTUSER
 68：     
 69：     ' 明細レコードの取得
 70：     ' DataObj.SlipDetailコンポーネントの実体化
 71：     Set objDataSlipDetail = CreateObject("DataObj.SlipDetail")
 72：     Set objRecSlipDetail = objDataSlipDetail.GetRecords(SlipID)
 73：     
 74：     ' DataObj.Stockコンポーネントの実体化
 75：     Set objDataStock = CreateObject("DataObj.Stock")
 76：     
 77：     ' すべての明細についてループ
 78：     While Not objRecSlipDetail.EOF
 79：         If Not objRecSlipDetail.Fields("DELETEDFLAG").Value Then
 80：             ' 在庫情報テーブルに出庫情報を追加する
 81：             objDataStock.AddRecord old_DELIVERDATE, _
   　                                    objRecSlipDetail.Fields("PRODUCTID").Value, _
   　                                    -objRecSlipDetail.Fields("NUMBER").Value, _
   　                                    objRecSlipDetail.Fields("MEMO").Value, _
   　                                    SlipID
 82：         End If
 83：         
 84：         ' 次のレコードに移動
 85：         objRecSlipDetail.MoveNext
 86：     Wend
 87：     
 88：     objRecSlipDetail.Close
 89：     Set objRecSlipDetail = Nothing
 90：     
 91：     ' 各種コンポーネントの解放
 92：     Set objDataStock = Nothing
 93：     Set objDataSlipDetail = Nothing
 94：     Set objDataSlipInformation = Nothing
 95：     Set objDataSlip = Nothing
 96：     
 97：     ' トランザクションのコミット
 98：     objContext.SetComplete
 99：     
100：     ' オブジェクトコンテキストの解放
101：     Set objContext = Nothing
102：     
103：     Exit Sub
104： 
105： ErrHandle:
106：     ' エラーハンドラ
107：     objContext.SetAbort
108：     Set objDataSlip = Nothing
109：     Set objDataSlipInformation = Nothing
110：     Set objDataSlipDetail = Nothing
111：     Set objDataStock = Nothing
112：     Set objRecSlipDetail = Nothing
113：     
114：     ' エラーの再発行
115：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
116： End Sub