List 6-88 DataObj.StockコンポーネントのGetRecordsメソッド
1： Public Function GetRecords(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, _
ByVal IncludeDeleted As Boolean) _
As ADODB.Recordset
2： ' 登録されている入庫または出庫予定を
3： ' ADODB.Recordsetオブジェクトとして返す
4： ' 【引数】
5： ' FilterFlag = 絞り込む条件
6： ' FILTER_STOCK列挙型の組み合わせを指定する
7： ' start_DATE = 予定日による絞り込み条件
8： ' この値よりも等しいか大きい予定日のものだけを返す
9： ' Nullを指定した場合には無視
10： ' end_Date = 予定日による絞り込み条件
11： ' この値よりも等しいか小さい予定日のものだけを返す
12： ' Nullを指定した場合には無視
13： ' start_DUEDATE = 施行日による絞り込み条件
14： ' この値よりも等しいか大きい施行日のものだけを返す
15： ' Nullを指定した場合には無視
16： ' end_DUEDATE = 施行日による絞り込み条件
17： ' この値よりも等しいか小さい施行日のものだけを返す
18： ' Nullを指定した場合には無視
19： ' IncludeDeleted = 削除ずみを含むかどうかのフラグ
20： ' Trueのとき削除ずみを含む，Falseのとき削除ずみを含まない
21： ' 【戻り値】
22： ' 指定された条件に合致する入庫または出庫の予定を含む
23： ' ADODB.Recordsetオブジェクト
24： ' 戻り値となるADODB.Recordsetオブジェクトは
25： ' 読み取り専用の閉じたRecordset
26： Dim objContext As ObjectContext
27： Dim objRec As ADODB.Recordset
28： Dim strQuery As String
29： Dim userName As String
30：
31： ' オブジェクトコンテキストの取得
32： Set objContext = GetObjectContext()
33：
34： ' エラーハンドラの設定
35： On Error GoTo ErrHandle
36：
37： ' 発行するSELECT文
38： strQuery = "SELECT 在庫情報.ID As ID," & _
"在庫情報.DATE As DATE, " & _
"在庫情報.DUEDATE As DUEDATE," & _
"在庫情報.CONFIRMEDFLAG As CONFIRMEDFLAG, " & _
"在庫情報.PRODUCTID As PRODUCTID," & _
"製品情報.PRODUCTNAME As PRODUCTNAME," & _
"在庫情報.NUMBER As NUMBER, " & _
"在庫情報.MEMO As MEMO," & _
"在庫情報.SLIPID As SLIPID," & _
"在庫情報.MADEUSER As MADEUSER," & _
"在庫情報.MADEDATE As MADEDATE," & _
"在庫情報.LASTUSER As LASTUSER," & _
"在庫情報.LASTDATE As LASTDATE," & _
"在庫情報.DELETEDFLAG As DELETEDFLAG" & _
" FROM 在庫情報, 製品情報" & _
" WHERE 在庫情報.PRODUCTID=製品情報.ID"
39：
40： ' 条件による絞り込み
41： If FilterFlag And FILTER_STOCK_OWNER Then
42： ' 自分が登録したレコードだけに絞り込む
43： userName = objContext.Security.GetOriginalCallerName()
44： strQuery = strQuery & " AND 在庫情報.MADEUSER='" & _
userName & "'"
45： End If
46： If FilterFlag And FILTER_STOCK_INONLY Then
47： ' 入庫レコードのみとする
48： strQuery = strQuery & " AND 在庫情報.SLIPID=Null"
49： End If
50： If FilterFlag And FILTER_STOCK_OUTONLY Then
51： ' 出庫レコードのみとする
52： strQuery = strQuery & " AND 在庫情報.SLIPID<>Null"
53： End If
54： If FilterFlag And FILTER_STOCK_DUEONLY Then
55： ' 施行ずみだけに絞り込む
56： strQuery = strQuery & " AND 在庫情報.CONFIRMEDFLAG=1"
57： End If
58： If FilterFlag And FILTER_STOCK_NODUEONLY Then
59： ' 施行まえだけに絞り込む
60： strQuery = strQuery & " AND 在庫情報.CONFIRMEDFLAG=0"
61： End If
62：
63： ' 日付による絞り込み
64： If Not IsNull(start_DATE) Then
65： ' 予定日による絞り込み
66： If Not IsDate(start_DATE) Then
67： Err.Raise Errorcode.Err_WILLDAY, App.Title, _
"予定日の設定が不正です"
68： End If
69： strQuery = strQuery & " AND 在庫情報.DATE >='" & _
FormatDateTime(start_DATE) & "'"
70： End If
71： If Not IsNull(end_Date) Then
72： ' 予定日による絞り込み
73： If Not IsDate(end_Date) Then
74： Err.Raise Errorcode.Err_WILLDAY, App.Title, _
"予定日の設定が不正です"
75： End If
76： strQuery = strQuery & " AND 在庫情報.DATE <='" & _
FormatDateTime(end_Date) & " '"
77： End If
78： If Not IsNull(start_DUEDATE) Then
79： ' 施行日による絞り込み
80： If Not IsDate(start_DUEDATE) Then
81： Err.Raise Errorcode.Err_DUEDATE, App.Title, _
"施行日の設定が不正です"
82： End If
83： strQuery = strQuery & " AND 在庫情報.DUEDATE >='" & _
FormatDateTime(start_DUEDATE) & "'"
84： End If
85： If Not IsNull(end_DUEDATE) Then
86： ' 施行日による絞り込み
87： If Not IsDate(end_DUEDATE) Then
88： Err.Raise Errorcode.Err_DUEDATE, App.Title, _
"施行日の設定が不正です"
89： End If
90： strQuery = strQuery & " AND 在庫情報.DUEDATE <='" & _
FormatDateTime(end_DUEDATE) & "'"
91： End If
92：
93： ' 削除ずみを含まないようにするか
94： If Not IncludeDeleted Then
95： strQuery = strQuery & " AND DELETEDFLAG=0"
96： End If
97：
98： ' データベースと接続し，SELECT文を発行する
99： Set objRec = CreateObject("ADODB.Recordset")
100： ' カーソルロケーションをクライアントカーソルに設定する
101： objRec.CursorLocation = adUseClient
102：
103： ' SELECT文の実行
104： objRec.Open strQuery, g_DBConnection, adOpenStatic, _
adLockReadOnly, adCmdText
105：
106： ' データベースコネクションを切り離す
107： Set objRec.ActiveConnection = Nothing
108：
109： ' 取得したレコードセットを戻り値とする
110： Set GetRecords = objRec
111： Set objRec = Nothing
112：
113： ' コミットする
114： objContext.SetComplete
115：
116： ' オブジェクトコンテキストの解放
117： Set objContext = Nothing
118：
119： Exit Function
120：
121： ErrHandle:
122： ' エラーハンドラ
123： objContext.SetAbort
124：
125： Set objContext = Nothing
126： Set objRec = Nothing
127：
128： ' エラーの再発行
129： Err.Raise Err.NUMBER, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
130： End Function