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

  1： Public Function GetSlips(ByVal start_MADEDATE As Variant, _
   　                          ByVal end_MADEDATE As Variant, _
   　                          ByVal start_DELIVERDATE As Variant, _
   　                          ByVal end_DELIVERDATE As Variant, _
   　                          ByVal IncludeOtherMade As Boolean, _
   　                          ByVal filterSlip As FILTER_SLIP, _
   　                          ByVal IncludeDeleted As Boolean) As ADODB.Recordset
  2： 
  3：     ' 指定された条件に合致する伝票の一覧を返す
  4：     ' 【引数】
  5：     '   start_MADEDATE = 起票日による絞り込みの開始日（この日を含む）。
  6：     '                    Nullのときには絞り込みなし
  7：     '   end_MADEDATE =  起票日による絞り込みの終了日（この日を含む）。
  8：     '                    Nullのときには絞り込みなし
  9：     '   start_DELIVERDATE = 納入予定日による絞り込みの開始日（この日を含む）。
 10：     '                       Nullのときには絞り込みなし
 11：     '   end_DELIVERDATE = 納入予定日による絞り込みの終了日（この日を含む）。
 12：     '                     Nullのときには絞り込みなし
 13：     '   IncludeOtherMade = 他人が起票した伝票も含むかどうかのフラグ。
 14：     '                      Trueのときには含み，Falseのときには含まない
 15：     '   filterSlip = 伝票の状態による絞り込み。FILTER_SLIP列挙型の組み合わせ。
 16：     '                FILTER_SLIP_ALLのときにはすべての伝票
 17：     '   IncludeDeleted = 削除ずみを含むかどうかのフラグ。
 18：     '                    Trueで含む。Falseで含まない
 19：     ' 【戻り値】
 20：     '   条件に合致する伝票の一覧を含むADODB.Recordsetオブジェクト
 21：     '   戻り値となるADODB.Recordsetオブジェクトは読み取り専用の閉じたレコードセット
 22：     Dim objContext As ObjectContext
 23：     Dim objDataSlip As DataObj.Slip
 24：     
 25：     ' オブジェクトコンテキストの取得
 26：     Set objContext = GetObjectContext()
 27：     
 28：     ' エラーハンドラの設定
 29：     On Error GoTo ErrHandle
 30：     
 31：     ' ロールを調べ，いくつかの値を制限する
 32：     If Not objContext.IsSecurityEnabled() Then
 33：         ' セキュリティ設定が無効
 34：         Err.Raise ERR_NOSECURE, App.Title, "セキュリティ機構が無効です"
 35：     End If
 36：     
 37：     ' filterSlipの制限を変更
 38：     If objContext.IsCallerInRole("AllAdmin") Or _
   　        objContext.IsCallerInRole("SalesAdmin") Or _
   　        objContext.IsCallerInRole("SalesManager") Or _
   　        objContext.IsCallerInRole("Sales") Then
 39：         ' AllAdmin，SalesAdmin，SalesManager，Salesのときには制限なし
 40：         
 41：     Else
 42：         ' FILTER_SLIP_CREATING，
 43：         ' FILTER_SLIP_REJECTED，FILTER_SLIP_REQUESTINGCONSENTの指定は禁止
 44：         filterSlip = filterSlip And _
   　                        (Not (FILTER_SLIP_CREATING Or _
   　                              FILTER_SLIP_REJECTED Or FILTER_SLIP_REQUESTINGCONSENT))
 45：         If Not (objContext.IsCallerInRole("Products") Or _
   　            objContext.IsCallerInRole("ProductsAdmin")) Then
 46：             ' FILTER_SLIP_CONSENTEDも禁止
 47：             filterSlip = filterSlip And (Not FILTER_SLIP_CONSENTED)
 48：         End If
 49：     End If
 50：     
 51：     ' IncludeDeletedの制限
 52：     If Not (objContext.IsCallerInRole("AllAdmin") Or _
   　            objContext.IsCallerInRole("SalesAdmin") Or _
   　            objContext.IsCallerInRole("ProductsAdmin") Or _
   　            objContext.IsCallerInRole("AccountingAdmin")) Then
 53：         ' IncludeDeletedはFalseに固定
 54：         IncludeDeleted = False
 55：     End If
 56：     
 57：     ' DataObj.Slipコンポーネントの実体化
 58：     Set objDataSlip = CreateObject("DataObj.Slip")
 59：     
 60：     ' 伝票一覧を取得し，戻り値とする
 61：     Set GetSlips = objDataSlip.GetRecords(start_MADEDATE, end_MADEDATE, _
   　                                           start_DELIVERDATE, end_DELIVERDATE, _
   　                                           IncludeOtherMade, filterSlip, _
   　                                           IncludeDeleted)
 62：     ' DataObj.Slipコンポーネントの解放
 63：     Set objDataSlip = Nothing
 64：     
 65：     ' トランザクションのコミット
 66：     objContext.SetComplete
 67：     
 68：     ' オブジェクトコンテキストの解放
 69：     Set objContext = Nothing
 70：     
 71：     Exit Function
 72： 
 73： ErrHandle:
 74：     ' エラーハンドラ
 75：     objContext.SetAbort
 76：     Set objContext = Nothing
 77：     Set objDataSlip = Nothing
 78：     
 79：     ' エラーの再発行
 80：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 81： End Function