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

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