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