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

  1： Public Sub UndeleteStorage(ByVal StockID As Long)
  2：     ' 指定された入庫予定レコードを復活させる
  3：     ' 【引数】
  4：     '   StockID = 復活したいレコードを特定するレコードID（IDフィールドの値）
  5：     ' 【戻り値】
  6：     '   なし
  7：     Dim objContext As ObjectContext
  8：     Dim objDataStock As DataObj.STOCK
  9：     Dim objDataProduct As DataObj.Product
 10：     Dim objDataSlip As DataObj.Slip
 11：     Dim WillDate As Variant, DUEDATE As Variant, CONFIRMEDFLAG As Variant
 12：     Dim ProductID As Variant, NUMBER As Variant, MEMO As Variant
 13：     Dim SLIPID As Variant, MADEUSER As Variant, MADEDATE As Variant
 14：     Dim LASTUSER As Variant, LASTDATE As Variant
 15：     
 16：     ' オブジェクトコンテキストの取得
 17：     Set objContext = GetObjectContext()
 18：     
 19：     ' エラーハンドラの設定
 20：     On Error GoTo ErrHandle
 21：     
 22：     ' DataObj.Stock，DataObj.Productの実体化
 23：     Set objDataStock = CreateObject("DataObj.Stock")
 24：     Set objDataProduct = CreateObject("DataObj.Product")
 25：     
 26：     ' 現在のデータを取得
 27：     objDataStock.GetRecord StockID, WillDate, DUEDATE, CONFIRMEDFLAG, _
   　                            ProductID, NUMBER, MEMO, SLIPID, _
   　                            MADEUSER, MADEDATE, LASTUSER, LASTDATE
 28：     
 29：     ' 入庫データであることを確認
 30：     If Not IsNull(SLIPID) Then
 31：         ' これは出庫用のレコード
 32：         Err.Raise BusinessError.ERR_CANTACCESS, App.Title, _
   　                   "出庫予定を操作することはできません"
 33：     End If
 34： 
 35：     ' 復活させたときに製品がまだ存在することを確認
 36：     If objDataProduct.IsDeleted(ProductID) <> ID_Exists Then
 37：         ' 製品がもうない
 38：         Err.Raise BusinessError.ERR_CANTACCESS, App.Title, _
   　                   "入庫予定が指し示す伝票がすでに削除されているため復活できません"
 39：     End If
 40：     
 41：     ' DELETEDFLAGフィールドの値をFalseに設定し，復活させる
 42：     objDataStock.SetDeletedFlag StockID, False
 43：     
 44：     ' DataObj.Stock，DataObj.Productの解放
 45：     Set objDataProduct = Nothing
 46：     Set objDataStock = Nothing
 47：     
 48：     ' コミットする
 49：     objContext.SetComplete
 50：     
 51：     ' オブジェクトコンテキストの解放
 52：     Set objContext = Nothing
 53：     
 54：     Exit Sub
 55：     
 56： ErrHandle:
 57：     ' エラーハンドラ
 58：     objContext.SetAbort
 59：     Set objContext = Nothing
 60：     Set objDataStock = Nothing
 61：     Set objDataProduct = Nothing
 62：     
 63：     ' エラーの再発行
 64：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 65： End Sub