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

  1： Public Function AddStorage(ByVal WillDate As Variant, _
   　                            ByVal ProductID As Variant, _
   　                            ByVal Number As Variant, _
   　                            ByVal MEMO As Variant) As Long
  2：     ' 在庫情報テーブルの入庫予定レコードを加える
  3：     ' 【引数】
  4：     '   WillDate = 入庫の予定日
  5：     '   ProductID = 入庫製品を特定する製品番号
  6：     '   Number = 入庫予定数
  7：     '   MEMO = 摘要
  8：     ' 【戻り値】
  9：     '   登録した入庫を示すレコードのレコードID
 10：     Dim objContext As ObjectContext
 11：     Dim objDataStock As DataObj.STOCK
 12：     Dim objDataProduct As DataObj.Product
 13：     
 14：     ' オブジェクトコンテキストの取得
 15：     Set objContext = GetObjectContext()
 16：     
 17：     ' エラーハンドラの設定
 18：     On Error GoTo ErrHandle
 19：     
 20：     ' 数量が負でないことを確認
 21：     If Number < 0 Then
 22：         Err.Raise Errorcode.Err_NUMBER, App.Title, _
   　                   "数量が不正です"
 23：     End If
 24：     
 25：     ' DataObj.Stockコンポーネントの実体化
 26：     Set objDataStock = CreateObject("DataObj.Stock")
 27：     ' DataObj.Productコンポーネントの実体化
 28：     Set objDataProduct = CreateObject("DataObj.Product")
 29：     
 30：     ' 該当製品があるかどうかをチェック
 31：     If objDataProduct.IsDeleted(ProductID) <> ID_Exists Then
 32：         ' 製品が存在しない
 33：         Err.Raise Err_NotFound, App.Title, _
   　                   "指定された製品が見つかりません"
 34：     End If
 35：     
 36：     ' DataObj.Productの解放
 37：     Set objDataProduct = Nothing
 38：     
 39：     ' AddRecordメソッドを呼び出して登録
 40：     AddStorage = objDataStock.AddRecord(WillDate, ProductID, _
   　                                         Number, MEMO, Null)
 41：     
 42：     ' DataObj.Stockの解放
 43：     Set objDataStock = Nothing
 44：     
 45：     ' コミットする
 46：     objContext.SetComplete
 47：     
 48：     ' オブジェクトコンテキストの解放
 49：     Set objContext = Nothing
 50：     
 51：     Exit Function
 52： 
 53： ErrHandle:
 54：     ' エラーハンドラ
 55：     objContext.SetAbort
 56：     Set objContext = Nothing
 57：     Set objDataStock = Nothing
 58：     Set objDataProduct = Nothing
 59：     
 60：     AddStorage = -1
 61：     
 62：     ' エラーの再発行
 63：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 64： End Function