List 6-171　修正した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, _
                               Optional ByVal CustomerID As Long = -1) _
   　                          ) 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：     '   CustomerID = 顧客による絞り込み。顧客番号を指定する。
 20：     '                負のときまたは省略されたときには顧客による絞り込みなし
 21：     ' 【戻り値】
 22：     '   条件に合致する伝票の一覧を含むADODB.Recordsetオブジェクト
 23：     '   戻り値となるADODB.Recordsetオブジェクトは読み取り専用の閉じたレコードセット
 24：     Dim objContext As ObjectContext
 25：     Dim objDataSlip As DataObj.Slip
 26：     
 27：     ' オブジェクトコンテキストの取得
 28：     Set objContext = GetObjectContext()
 29：     
 30：     ' エラーハンドラの設定
 31：     On Error GoTo ErrHandle
 32：     
 33：     ' ロールを調べ，いくつかの値を制限する
 34：     If Not objContext.IsSecurityEnabled() Then
 35：         ' セキュリティ設定が無効
 36：         Err.Raise ERR_NOSECURE, App.Title, "セキュリティ機構が無効です"
 37：     End If
 38：     
 39：     ' filterSlipの制限を変更
 40：     If objContext.IsCallerInRole("AllAdmin") Or _
   　        objContext.IsCallerInRole("SalesAdmin") Or _
   　        objContext.IsCallerInRole("SalesManager") Or _
   　        objContext.IsCallerInRole("Sales") Then
 41：         ' AllAdmin，SalesAdmin，SalesManager，Salesのときには制限なし
 42：         
 43：     Else
 44：         ' FILTER_SLIP_CREATING，
 45：         ' FILTER_SLIP_REJECTED，FILTER_SLIP_REQUESTINGCONSENTの指定は禁止
 46：         filterSlip = filterSlip And _
   　                        (Not (FILTER_SLIP_CREATING Or _
   　                              FILTER_SLIP_REJECTED Or FILTER_SLIP_REQUESTINGCONSENT))
 47：         If Not (objContext.IsCallerInRole("Products") Or _
   　            objContext.IsCallerInRole("ProductsAdmin")) Then
 48：             ' FILTER_SLIP_CONSENTEDも禁止
 49：             filterSlip = filterSlip And (Not FILTER_SLIP_CONSENTED)
 50：         End If
 51：     End If
 52：     
 53：     ' IncludeDeletedの制限
 54：     If Not (objContext.IsCallerInRole("AllAdmin") Or _
   　            objContext.IsCallerInRole("SalesAdmin") Or _
   　            objContext.IsCallerInRole("ProductsAdmin") Or _
   　            objContext.IsCallerInRole("AccountingAdmin")) Then
 55：         ' IncludeDeletedはFalseに固定
 56：         IncludeDeleted = False
 57：     End If
 58：     
 59：     ' DataObj.Slipコンポーネントの実体化
 60：     Set objDataSlip = CreateObject("DataObj.Slip")
 61：     
 62：     ' 伝票一覧を取得し，戻り値とする
 63：     Set GetSlips = objDataSlip.GetRecords(start_MADEDATE, end_MADEDATE, _
   　                                           start_DELIVERDATE, end_DELIVERDATE, _
   　                                           IncludeOtherMade, filterSlip, _
   　                                           IncludeDeleted, CustomerID)
 64：     ' DataObj.Slipコンポーネントの解放
 65：     Set objDataSlip = Nothing
 66：     
 67：     ' トランザクションのコミット
 68：     objContext.SetComplete
 69：     
 70：     ' オブジェクトコンテキストの解放
 71：     Set objContext = Nothing
 72：     
 73：     Exit Function
 74： 
 75： ErrHandle:
 76：     ' エラーハンドラ
 77：     objContext.SetAbort
 78：     Set objContext = Nothing
 79：     Set objDataSlip = Nothing
 80：     
 81：     ' エラーの再発行
 82：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 83： End Function