List 6-133 DataObj.SlipコンポーネントのGetRecordsメソッド
1： Public Function GetRecords(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： ' start_MADEDATE = 起票日による絞り込みの開始日（この日を含む）。
5： ' Nullのときには絞り込みなし
6： ' end_MADEDATE = 起票日による絞り込みの終了日（この日を含む）。
7： ' Nullのときには絞り込みなし
8： ' start_DELIVERDATE = 納入予定日による絞り込みの開始日（この日を含む）。
9： ' Nullのときには絞り込みなし
10： ' end_DELIVERDATE = 納入予定日による絞り込みの終了日（この日を含む）。
11： ' Nullのときには絞り込みなし
12： ' IncludeOtherMade = 他人が起票した伝票も含むかどうかのフラグ。
13： ' Trueのときには含み，Falseのときには含まない
14： ' filterSlip = 伝票の状態による絞り込み。FILTER_SLIP列挙型の組み合わせ。
15： ' FILTER_SLIP_ALLのときにはすべての伝票
16： ' IncludeDeleted = 削除ずみを含むかどうかのフラグ。
17： ' Trueで含む。Falseで含まない
18： ' 【戻り値】
19： ' 条件に合致する伝票の一覧を含むADODB.Recordsetオブジェクト
20： ' 戻り値となるADODB.Recordsetオブジェクトは読み取り専用の閉じたレコードセット
21： Dim objContext As ObjectContext
22： Dim objRec As ADODB.Recordset
23： Dim strQuery As String
24： Dim userName As String, OrStr As String
25：
26： ' オブジェクトコンテキストの取得
27： Set objContext = GetObjectContext()
28：
29： ' エラーハンドラの設定
30： On Error GoTo ErrHandle
31：
32： ' 発行するSELECT文
33： strQuery = "SELECT 伝票情報.ID As ID, 伝票情報.CUSTOMERID, " & _
"顧客情報.NAME As CUSTOMERNAME, 伝票情報.SUBTOTAL As SUBTOTAL," & _
"伝票情報.TAX As TAX, 伝票情報.TOTAL As TOTAL," & _
"伝票情報.BILLID As BILLID, 伝票情報.BILLDATE As BILLDATE," & _
"伝票情報.MADEBILLFLAG As MADEBILLFLAG, 伝票情報.ONEBILLFLAG As ONEBILLFLAG," & _
"伝票情報.REQ_CONSENTFLAG As REQ_CONSENTFLAG, 伝票情報.REQ_CONSENTDATE As REQ_CONSENTDATE," & _
"伝票情報.REQ_CONSENTCOMMENT As REQ_CONSENTCOMMENT, 伝票情報.CONSENTEDFLAG As CONSENTEDFLAG," & _
"伝票情報.CONSENTEDDATE As CONSENTEDDATE, 伝票情報.CONSENTEDCOMMENT As COMSENTEDCOMMENT," & _
"伝票情報.REJECTEDFLAG As REJECTEDFLAG, 伝票情報.REJECTEDDATE As REJECTEDDATE," & _
"伝票情報.REJECTEDCOMMENT As REJECTEDCOMMENT, 伝票情報.SENDFLAG As SENDFLAG," & _
"伝票情報.SENDDATE As SENDDATE, 伝票情報.SENDCOMMENT As SENDCOMMENT," & _
"伝票追加情報.DIVISION As DIVISION, 伝票追加情報.PERSON As PERSON," & _
"伝票追加情報.DELIVERDATE As DELIVERDATE, 伝票追加情報.SENT_ADDR As SENT_ADDR," & _
"伝票追加情報.SENT_TEL As SENT_TEL, 伝票追加情報.MEMO As MEMO," & _
"伝票情報.ACCOUNTINGFLAG As ACCOUNTINGFLAG, 伝票情報.ACCOUNTINGDATE As ACCOUNTINGDATE," & _
"伝票情報.ACCOUNTINGCOMMENT As ACCOUNTINGCOMMENT, 伝票情報.MADEDATE," & _
"伝票情報.MADEUSER As MADEUSER, 伝票情報.REQ_CONSENTUSER As REQ_CONSENTUSER," & _
"伝票情報.CONSENTEDUSER As CONSENTEDUSER, 伝票情報.REJECTEDUSER As REJECTEDUSER," & _
"伝票情報.SENDUSER As SENDUSER, 伝票情報.ACCOUNTINGUSER As ACCOUNTINGUSER," & _
"伝票情報.LASTUSER As LASTUSER, 伝票情報.LASTDATE As LASTDATE," & _
"伝票情報.DELETEDFLAG As DELETEDFLAG" & _
" FROM 伝票情報, 顧客情報, 伝票追加情報" & _
" WHERE 伝票情報.CUSTOMERID = 顧客情報.ID" & _
" AND 伝票情報.ID = 伝票追加情報.SLIPID" & _
" AND 伝票追加情報.DELETEDFLAG = 0"
34：
35： ' 絞り込みの条件式の設定
36： If Not IsNull(start_MADEDATE) Then
37： ' 起票日による絞り込みの開始日
38： If Not IsDate(start_MADEDATE) Then
39： Err.Raise Errorcode.Err_MADEDATE, App.Title, _
"起票日による絞り込み日時が不正です"
40： End If
41： strQuery = strQuery & " AND 伝票情報.MADEDATE >= '" & _
FormatDateTime(start_MADEDATE) & "'"
42： End If
43： If Not IsNull(end_MADEDATE) Then
44： ' 起票日による絞り込みの終了日
45： If Not IsDate(end_MADEDATE) Then
46： Err.Raise Errorcode.Err_MADEDATE, App.Title, _
"起票日による絞り込み日時が不正です"
47： End If
48： strQuery = strQuery & " AND 伝票情報.MADEDATE <= '" & _
FormatDateTime(end_MADEDATE) & "'"
49： End If
50： If Not IsNull(start_DELIVERDATE) Then
51： ' 納入予定日による絞り込みの開始日
52： If Not IsDate(start_DELIVERDATE) Then
53： Err.Raise Errorcode.Err_DELIVERDATE, App.Title, _
"納入予定日による絞り込み日時が不正です"
54： End If
55： strQuery = strQuery & " AND 伝票追加情報.DELIVERDATE >= '" & _
FormatDateTime(start_DELIVERDATE) & "'"
56： End If
57： If Not IsNull(end_DELIVERDATE) Then
58： ' 納入予定日による絞り込みの終了日
59： If Not IsDate(end_DELIVERDATE) Then
60： Err.Raise Errorcode.Err_DELIVERDATE, App.Title, _
"納入予定日による絞り込み日時が不正です"
61： End If
62： strQuery = strQuery & " AND 伝票追加情報.DELIVERDATE <= '" & _
FormatDateTime(end_DELIVERDATE) & "'"
63： End If
64： If Not IncludeOtherMade Then
65： ' 他人が起票した伝票は含めない
66： ' 呼び出したユーザーのユーザー名を取得
67： userName = objContext.Security.GetOriginalCallerName()
68： strQuery = strQuery & " AND 伝票情報.MADEUSER = '" & userName & "'"
69： End If
70： If Not IncludeDeleted Then
71： ' 削除ずみを含まない
72： strQuery = strQuery & " AND 伝票情報.DELETEDFLAG=0"
73： End If
74：
75： ' 伝票の状態による絞り込み
76： If filterSlip <> FILTER_SLIP_ALL Then
77： strQuery = strQuery & " AND ("
78： OrStr = ""
79： If filterSlip And FILTER_SLIP_CREATING Then
80： ' 作成中の伝票だけ
81： strQuery = strQuery & OrStr
82： strQuery = strQuery & "(伝票情報.MADEBILLFLAG=0" & _
" AND 伝票情報.REQ_CONSENTFLAG=0" & _
" AND 伝票情報.CONSENTEDFLAG=0" & _
" AND 伝票情報.REJECTEDFLAG=0" & _
" AND 伝票情報.SENDFLAG=0" & _
" AND 伝票情報.ACCOUNTINGFLAG=0)"
83： OrStr = " Or "
84： End If
85：
86： If filterSlip And FILTER_SLIP_REJECTED Then
87： ' 却下された伝票だけ
88： strQuery = strQuery & OrStr
89： strQuery = strQuery & "伝票情報.REJECTEDFLAG=1"
90： OrStr = " Or "
91： End If
92：
93： If filterSlip And FILTER_SLIP_REQUESTINGCONSENT Then
94： ' 承認依頼中の伝票だけ
95： strQuery = strQuery & OrStr
96： strQuery = strQuery & "伝票情報.REQ_CONSENTFLAG=1"
97： OrStr = " Or "
98： End If
99：
100： If filterSlip And FILTER_SLIP_CONSENTED Then
101： ' 承認ずみの伝票だけ
102： strQuery = strQuery & OrStr
103： strQuery = strQuery & "伝票情報.CONSENTEDFLAG=1"
104： OrStr = " Or "
105： End If
106：
107： If filterSlip And FILTER_SLIP_SEND Then
108： ' 発送ずみの伝票だけ
109： strQuery = strQuery & OrStr
110： strQuery = strQuery & "伝票情報.SENDFLAG=1"
111： OrStr = " Or "
112： End If
113：
114： If filterSlip And FILTER_SLIP_ACCOUNTED Then
115： ' 経理確認ずみの伝票だけ
116： strQuery = strQuery & OrStr
117： strQuery = strQuery & "伝票情報.ACCOUNTINGFLAG=1"
118： OrStr = " Or "
119： End If
120：
121： If filterSlip And FILTER_SLIP_FINISH Then
122： ' すべての処理が完了した伝票のみ
123： strQuery = strQuery & OrStr
124： strQuery = strQuery & "伝票情報.MADEBILLFLAG=1"
125： End If
126：
127： strQuery = strQuery & ")"
128： End If
129：
130： ' データベースと接続し，SELECT文を発行する
131： Set objRec = CreateObject("ADODB.Recordset")
132： ' カーソルロケーションをクライアントカーソルに設定する
133： objRec.CursorLocation = adUseClient
134：
135： ' SELECT文の実行
136： objRec.Open strQuery, g_DBConnection, adOpenStatic, _
adLockReadOnly, adCmdText
137：
138： ' データベースコネクションの切除
139： Set objRec.ActiveConnection = Nothing
140：
141： ' 取得したレコードセットを戻り値とする
142： Set GetRecords = objRec
143： Set objRec = Nothing
144：
145： ' トランザクションのコミット
146： objContext.SetComplete
147：
148： ' オブジェクトコンテキストの解放
149： Set objContext = Nothing
150：
151： Exit Function
152：
153： ErrHandle:
154： ' エラーハンドラ
155： objContext.SetAbort
156： Set objContext = Nothing
157： Set objRec = Nothing
158：
159： ' エラーの再発行
160： Err.Raise Err.NUMBER, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
161： End Function