List 6-155　Business.ProductコンポーネントのGetReadyDate_Productメソッド

  1： Public Function GetReadyDate_Product(ByVal ProductID As Long, _
   　                                      ByVal Number As Long) As Variant
  2：     ' 指定された製品が指定された数量だけ揃う日付を返す
  3：     ' 【引数】
  4：     '   ProductID = 製品を指定する製品番号
  5：     '   Number = 製品の数量
  6：     ' 【戻り値】
  7：     '   指定された数量が在庫として使えるようになる日付
  8：     '   その時点のところ指定された数量だけを満たす入庫予定がなければNullを返す
  9：     Dim objContext As ObjectContext
 10：     Dim objDataProduct As DataObj.Product
 11：     Dim objDataStock As DataObj.STOCK
 12：     Dim NowStock As Long
 13：     
 14：     ' オブジェクトコンテキストの取得
 15：     Set objContext = GetObjectContext()
 16：     
 17：     ' エラーハンドラの設定
 18：     On Error GoTo ErrHandle
 19：     
 20：     ' DataObj.Productコンポーネントの実体化
 21：     Set objDataProduct = CreateObject("DataObj.Product")
 22：         
 23：     ' 製品が存在することを確認
 24：     If objDataProduct.IsDeleted(ProductID) <> ID_Exists Then
 25：         Err.Raise Err_NOTFOUND, App.Title, _
   　                   "指定された製品が見つかりません"
 26：     End If
 27：     
 28：     ' 現在，在庫として利用できる数量を取得
 29：     NowStock = objDataProduct.GetNowStock(ProductID)
 30：     If NowStock < Number Then
 31：         ' 在庫が足りない
 32：         ' 在庫が揃う日付を調査し，それを戻り値とする
 33：         Set objDataStock = CreateObject("DataObj.Stock")
 34：         GetReadyDate_Product = objDataStock.GetReadyDate(ProductID, Number - NowStock)
 35：         Set objDataStock = Nothing
 36：     Else
 37：         ' 在庫が足りている
 38：         ' その時点の日付を戻り値とする
 39：         GetReadyDate_Product = Date
 40：     End If
 41：     
 42：     Set objDataProduct = Nothing
 43：     
 44：     ' トランザクションのコミット
 45：     objContext.SetComplete
 46：     
 47：     ' オブジェクトコンテキストの解放
 48：     Set objContext = Nothing
 49：     
 50：     Exit Function
 51：     
 52： ErrHandle:
 53：     ' エラーハンドラ
 54：     objContext.SetAbort
 55：     Set objDataProduct = Nothing
 56：     Set objDataStock = Nothing
 57：     
 58：     ' エラーの再発行
 59：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 60： End Function