List 6-89　Business.StockコンポーネントのGetStoragesメソッド

  1： Public Function GetStorages(ByVal FilterFlag As FILTER_STOCK, _
   　                             ByVal start_DATE As Variant, _
   　                             ByVal end_Date As Variant, _
   　                             ByVal start_DUEDATE As Variant, _
   　                             ByVal end_DUEDATE As Variant) _
   　                             As ADODB.Recordset
  2：     ' 登録されている入庫または出庫予定を
  3：     ' ADODB.Recordsetオブジェクトとして返す
  4：     ' ProductsAdminロールまたはAllAdminロールに属する場合には
  5：     ' 削除ずみのものも含めて返す
  6：     ' 【引数】
  7：     '   FilterFlag = 絞り込む条件
  8：     '                FILTER_STOCK列挙型の組み合わせを指定する
  9：     '   start_DATE = 予定日による絞り込み条件
 10：     '                この値よりも等しいか大きい予定日のものだけを返す
 11：     '                Nullを指定した場合には無視
 12：     '   end_Date = 予定日による絞り込み条件
 13：     '              この値よりも等しいか小さい予定日のものだけを返す
 14：     '              Nullを指定した場合には無視
 15：     '   start_DUEDATE = 施行日による絞り込み条件
 16：     '                   この値よりも等しいか大きい施行日のものだけを返す
 17：     '                   Nullを指定した場合には無視
 18：     '   end_DUEDATE = 施行日による絞り込み条件
 19：     '                 この値よりも等しいか小さい施行日のものだけを返す
 20：     '                 Nullを指定した場合には無視
 21：     ' 【戻り値】
 22：     '   指定された条件に合致する入庫または出庫の予定を含む
 23：     '   ADODB.Recordsetオブジェクト
 24：     '   戻り値となるADODB.Recordsetオブジェクトは読み取り専用の閉じたRecordset
 25：     Dim objContext As ObjectContext
 26：     Dim objDataStock As DataObj.STOCK
 27：     Dim IncludeDeletedFlag As Boolean
 28：     
 29：     ' オブジェクトコンテキストの取得
 30：     Set objContext = GetObjectContext()
 31：     
 32：     ' エラーハンドラの設定
 33：     On Error GoTo ErrHandle
 34：     
 35：     ' DataObj.Stockコンポーネントの実体化
 36：     Set objDataStock = CreateObject("DataObj.Stock")
 37：     
 38：     ' GetRecordsメソッドを呼び出してレコードを取得
 39：     ' 削除ずみを含めるかどうか
 40：     If Not objContext.IsSecurityEnabled() Then
 41：         ' 削除ずみを含めない
 42：         IncludeDeletedFlag = False
 43：     Else
 44：         If objContext.IsCallerInRole("ProductsAdmin") Or _
   　              objContext.IsCallerInRole("AllAdmin") Then
 45：             ' 削除ずみを含める
 46：             IncludeDeletedFlag = True
 47：         Else
 48：             ' 削除ずみを含めない
 49：             IncludeDeletedFlag = False
 50：         End If
 51：     End If
 52：     
 53：     Set GetStorages = objDataStock.GetRecords(FilterFlag, start_DATE, end_Date, _
   　                                               start_DUEDATE, end_DUEDATE, _
   　                                               IncludeDeletedFlag)
 54：     
 55：     ' DataObj.Stockの解放
 56：     Set objDataStock = Nothing
 57：     
 58：     ' コミットする
 59：     objContext.SetComplete
 60：     
 61：     ' オブジェクトコンテキストの解放
 62：     Set objContext = Nothing
 63：     
 64：     Exit Function
 65：     
 66： ErrHandle:
 67：     ' エラーハンドラ
 68：     objContext.SetAbort
 69：     Set objContext = Nothing
 70：     Set objDataStock = Nothing
 71： 
 72：     ' エラーの再発行
 73：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 74： End Function