List 6-192　Business.BillコンポーネントのCancelSubmitBillメソッド

  1： Public Sub CancelSubmitBill(ByVal BillID As Long)
  2：     ' 指定された請求書を入金ずみから送付ずみにまで戻す
  3：     ' 【引数】
  4：     '   BillID = 請求書送付ずみに戻したい請求書の請求書番号
  5：     ' 【戻り値】
  6：     '   なし
  7：     Dim objContext As ObjectContext
  8：     Dim objDataBill As DataObj.Bill
  9：     Dim old_CUSTOMERID As Variant, old_STARTDATE As Variant
 10：     Dim old_ENDDATE As Variant, old_SUBTOTAL As Variant
 11：     Dim old_TAX As Variant, old_TOTAL As Variant
 12：     Dim old_SENDBILLFLAG As Variant, old_PAIDFLAG As Variant
 13：     Dim old_SUBMITUSER As Variant, old_SUBMITDATE As Variant
 14：     Dim old_MEMO As Variant, old_MADEUSER As Variant
 15：     Dim old_MADEDATE As Variant, old_LASTUSER As Variant
 16：     Dim old_LASTDATE As Variant
 17：     
 18：     ' オブジェクトコンテキストの取得
 19：     Set objContext = GetObjectContext()
 20：     
 21：     ' エラーハンドラの設定
 22：     On Error GoTo ErrHandle
 23：     
 24：     ' DataObj.Billコンポーネントを実体化
 25：     Set objDataBill = CreateObject("DataObj.Bill")
 26：     
 27：     ' 請求書の状態を取得
 28：     If objDataBill.Get_BillStatus(BillID) <> BILL_Paid Then
 29：         ' 入金ずみではない
 30：         Err.Raise BusinessError.ERR_CANTUPDATE, App.Title, _
   　                   "指定された請求書は入金ずみではありません"
 31：     End If
 32：     
 33：     ' ユーザーの確認
 34：     If Not objContext.IsSecurityEnabled() Then
 35：         ' セキュリティ設定が無効
 36：         Err.Raise Err_NOSECURE, App.Title, _
   　                   "セキュリティ機構が無効です"
 37：     End If
 38：     
 39：     ' 現在の情報を取得
 40：     objDataBill.GetRecord BillID, old_CUSTOMERID, old_STARTDATE, old_ENDDATE, _
   　                           old_SUBTOTAL, old_TAX, old_TOTAL, old_SENDBILLFLAG, _
   　                           old_PAIDFLAG, old_SUBMITUSER, old_SUBMITDATE, _
   　                           old_MEMO, old_MADEUSER, old_MADEDATE, old_LASTUSER, _
   　                           old_LASTDATE
 41：                           
 42：     ' 入金処理したユーザーは，このメソッドを呼び出したユーザーと一致するかどうかを判定
 43：     If objContext.Security.GetOriginalCallerName() <> old_SUBMITUSER Then
 44：         ' 一致しない
 45：         ' AccountingAdminロール，AllAdminロールならOK
 46：         If Not (objContext.IsCallerInRole("AccountingAdmin") Or _
   　                 objContext.IsCallerInRole("AllAdmin")) Then
 47：             ' AccountingAdminロールやAllAdminロールに属さない
 48：             Err.Raise Err_NOSECURE, App.Title, _
   　                       "他人が入金ずみとした請求書を変更することはできません"
 49：         End If
 50：     End If
 51：     
 52：     ' 以上で権限の調査が完了
 53：     
 54：     ' PAIDFLAGフィールドの値をFalseにする
 55：     objDataBill.Set_PAIDFLAG BillID, False, Null
 56：     ' SENDBILLFLAGフィールドの値をTrueにする
 57：     objDataBill.Set_SENDBILLFLAG BillID, True
 58：     
 59：     ' DataObj.Billコンポーネントの解放
 60：     Set objDataBill = Nothing
 61：     
 62：     ' トランザクションのコミット
 63：     objContext.SetComplete
 64：     
 65：     ' オブジェクトコンテキストの解放
 66：     Set objContext = Nothing
 67：     
 68：     Exit Sub
 69：     
 70： ErrHandle:
 71：     ' エラーハンドラ
 72：     objContext.SetAbort
 73：     
 74：     Set objDataBill = Nothing
 75：     Set objContext = Nothing
 76：     
 77：     ' エラーの再発行
 78：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 79： End Sub