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

  1： Public Sub SendSlip(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 objDataStock As DataObj.STOCK
 11：     Dim objDataProduct As DataObj.Product
 12：     Dim objRec As ADODB.Recordset
 13：     Dim SlipStatus As SlipStatus
 14：     
 15：     ' オブジェクトコンテキストの取得
 16：     Set objContext = GetObjectContext()
 17：     
 18：     ' エラーハンドラの設定
 19：     On Error GoTo ErrHandle
 20：     
 21：     ' DataObj.Slipコンポーネントの実体化
 22：     Set objDataSlip = CreateObject("DataObj.Slip")
 23：     
 24：     ' 伝票が存在することを確認
 25：     If objDataSlip.IsDeleted(SlipID) <> ID_Exists Then
 26：         ' 伝票が存在しない
 27：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
   　                   "指定された伝票は存在しません"
 28：     End If
 29：     
 30：     ' 伝票の状態を取得
 31：     SlipStatus = objDataSlip.Get_SlipStatus(SlipID)
 32：     If (SlipStatus <> Consented) Then
 33：         ' 伝票が承認ずみではない
 34：         Err.Raise BusinessError.ERR_CANTUPDATE, App.Title, _
   　                   "その伝票は承認されていません"
 35：     End If
 36：     
 37：     ' 権限の確認
 38：     If Not objContext.IsSecurityEnabled() Then
 39：         ' セキュリティ設定が無効
 40：         Err.Raise ERR_NOSECURE, App.Title, _
   　                   "セキュリティ機構が無効です"
 41：     End If
 42：     
 43：     If Not (objContext.IsCallerInRole("Products") Or _
   　         objContext.IsCallerInRole("ProductsAdmin") Or _
   　         objContext.IsCallerInRole("AllAdmin")) Then
 44：         ' Products，ProductsAdmin，AllAdminロールに属さない
 45：         Err.Raise ERR_NOSECURE, App.Title, _
   　                   "発送する権限がありません"
 46：     End If
 47：     
 48：     ' SENDFLAGフィールドの値をTrueにする
 49：     objDataSlip.Set_SENDFLAG SlipID, True, Comment
 50：     ' CONSENTEDFLAGフィールドの値をFalseにする
 51：     objDataSlip.Set_CONSENTEDFLAG SlipID, False, Null
 52：     
 53：     
 54：     ' DataObj.Stockコンポーネントの実体化
 55：     Set objDataStock = CreateObject("DataObj.Stock")
 56：     ' DataObj.Productコンポーネントの実体化
 57：     Set objDataProduct = CreateObject("DataObj.Product")
 58：     
 59：     ' この伝票から生じた出庫予定レコードを取得
 60：     Set objRec = objDataStock.GetRecordsBySlipID(SlipID)
 61：     
 62：     ' すべての出庫予定に対してループ
 63：     While Not objRec.EOF
 64：         ' 出庫予定レコードを施行ずみにする
 65：         objDataStock.SetConfirmedFlag objRec.Fields("ID").Value, True
 66：         ' 在庫数を減らす
 67：         '（NUMBERフィールドには負の数が入っている点に注意）
 68：         objDataProduct.AddStock objRec.Fields("PRODUCTID").Value, _
   　                                 objRec.Fields("NUMBER").Value
 69：         ' 予約数を減らす
 70：         '（NUMBERフィールドには負の数が入っている点に注意）
 71：         objDataProduct.AddBackOrder objRec.Fields("PRODUCTID").Value, _
   　                                     objRec.Fields("NUMBER").Value
 72：         
 73：         ' 次のレコードに移動
 74：         objRec.MoveNext
 75：     Wend
 76：     
 77：     objRec.Close
 78：     Set objRec = Nothing
 79：     
 80：     ' 各種コンポーネントの解放
 81：     Set objDataProduct = Nothing
 82：     Set objDataStock = Nothing
 83：     Set objDataSlip = Nothing
 84：     
 85：     ' トランザクションのコミット
 86：     objContext.SetComplete
 87：     
 88：     ' オブジェクトコンテキストの解放
 89：     Set objContext = Nothing
 90：     
 91：     Exit Sub
 92：     
 93： ErrHandle:
 94：     ' エラーハンドラ
 95：     objContext.SetAbort
 96：     Set objDataSlip = Nothing
 97：     Set objDataStock = Nothing
 98：     Set objDataProduct = Nothing
 99：     Set objRec = Nothing
100：     
101：     ' エラーの再発行
102：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
103： End Sub