List 6-156　Business.SlipコンポーネントのCancelRequestConsentメソッド

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