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

  1： Public Sub CancelSendSlip(ByVal SlipID)
  2：     ' 指定された伝票を発送ずみから承認ずみに戻す
  3：     ' 【引数】
  4：     '   SlipID = 承認ずみに戻したい伝票の伝票番号
  5：     ' 【戻り値】
  6：     '   なし
  7：     Dim objContext As ObjectContext
  8：     Dim objDataSlip As DataObj.Slip
  9：     Dim objDataStock As DataObj.STOCK
 10：     Dim objDataProduct As DataObj.Product
 11：     Dim objRec As ADODB.Recordset
 12：     Dim SlipStatus As SlipStatus
 13：     Dim old_SENDUSER As Variant, old_SENDDATE As Variant
 14：     Dim old_SENDCOMMENT As Variant
 15：     Dim old_CONSENTEDUSER As Variant, old_CONSENTEDDATE As Variant
 16：     Dim old_CONSENTEDCOMMENT As Variant
 17：     
 18：     ' オブジェクトコンテキストの取得
 19：     Set objContext = GetObjectContext()
 20：     
 21：     ' エラーハンドラの設定
 22：     On Error GoTo ErrHandle
 23：     
 24：     ' DataObj.Slipコンポーネントの実体化
 25：     Set objDataSlip = CreateObject("DataObj.Slip")
 26：     
 27：     ' 伝票が存在することを確認
 28：     If objDataSlip.IsDeleted(SlipID) <> ID_Exists Then
 29：         ' 伝票が存在しない
 30：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
   　                   "指定された伝票は存在しません"
 31：     End If
 32：     
 33：     ' 伝票の状態を取得
 34：     SlipStatus = objDataSlip.Get_SlipStatus(SlipID)
 35：     If (SlipStatus <> Send) Then
 36：         ' 伝票が発送ずみではない
 37：         Err.Raise BusinessError.ERR_CANTUPDATE, App.Title, _
   　                   "その伝票は発送ずみではありません"
 38：     End If
 39：     
 40：     ' 権限の確認
 41：     If Not objContext.IsSecurityEnabled() Then
 42：         ' セキュリティ設定が無効
 43：         Err.Raise ERR_NOSECURE, App.Title, _
   　                   "セキュリティ機構が無効です"
 44：     End If
 45： 
 46：     ' 発送ずみにしたユーザーの情報を取得
 47：     objDataSlip.GetRecord_Send SlipID, old_SENDUSER, old_SENDDATE, old_SENDCOMMENT
 48：     ' 発送ずみにしたユーザーと呼び出したユーザーが一致するか
 49：     If objContext.Security.GetOriginalCallerName() <> old_SENDUSER Then
 50：         ' 一致しない
 51：         ' ProductsAdminロールまたはAllAdminロールに属するのであれば，
 52：         ' 一致しなくてもよいものとする
 53：         If Not (objContext.IsCallerInRole("ProductsAdmin") Or _
   　                 objContext.IsCallerInRole("AllAdmin")) Then
 54：             ' ProductsAdminロールまたはAllAdminロールに属さない
 55：             Err.Raise ERR_NOSECURE, App.Title, _
   　                       "他人が発送ずみにした伝票を元に戻すことはできません"
 56：         End If
 57：     End If
 58：     
 59：     ' SENDFLAGフィールドの値をFalseにする
 60：     objDataSlip.Set_SENDFLAG SlipID, False, Null
 61：     ' CONSENTEDFLAGフィールドの値をTrueにする
 62：     objDataSlip.GetRecord_Consented SlipID, old_CONSENTEDUSER, _
   　                                     old_CONSENTEDDATE, old_CONSENTEDCOMMENT
 63：     objDataSlip.Set_CONSENTEDFLAG SlipID, True, old_CONSENTEDCOMMENT
 64：     
 65：     ' DataObj.Stockコンポーネントの実体化
 66：     Set objDataStock = CreateObject("DataObj.Stock")
 67：     ' DataObj.Productコンポーネントの実体化
 68：     Set objDataProduct = CreateObject("DataObj.Product")
 69：     
 70：     ' この伝票が生じた出庫予定レコードを取得
 71：     Set objRec = objDataStock.GetRecordsBySlipID(SlipID)
 72：     
 73：     ' すべての出庫予定に対してループ
 74：     While Not objRec.EOF
 75：         ' 出庫予定レコードを施行まえに戻す
 76：         objDataStock.SetConfirmedFlag objRec.Fields("ID").Value, False
 77：         ' 在庫数を増やす
 78：         '（NUMBERフィールドには負の数が入っている点に注意）
 79：         objDataProduct.AddStock objRec.Fields("PRODUCTID").Value, _
   　                                 -objRec.Fields("NUMBER").Value
 80：         ' 予約数を増やす
 81：         '（NUMBERフィールドには負の数が入っている点に注意）
 82：         objDataProduct.AddBackOrder objRec.Fields("PRODUCTID").Value, _
   　                                     -objRec.Fields("NUMBER").Value
 83：         
 84：         ' 次のレコードに移動
 85：         objRec.MoveNext
 86：     Wend
 87：     
 88：     objRec.Close
 89：     Set objRec = Nothing
 90：     
 91：     ' 各種コンポーネントの解放
 92：     Set objDataProduct = Nothing
 93：     Set objDataStock = 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 objDataStock = Nothing
109：     Set objDataProduct = Nothing
110：     Set objRec = Nothing
111：     
112：     ' エラーの再発行
113：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
114： End Sub