List 7-34 Form_CustomerフォームのBTN_SEARCH_Clickプロシージャ
1： Private Sub BTN_SEARCH_Click()
2： ' 検索する
3： Dim searchfield As Long
4： Dim order As ADODB.SearchDirectionEnum
5： Dim fieldname As String
6： Dim searchStr As String
7： Dim FindStr As String
8： Dim dateFlag As Boolean
9：
10： searchfield = COMBO_SEARCHFIELD.ListIndex
11： If searchfield = -1 Then
12： MsgBox "検索列が選択されていません", vbOKOnly, "検索エラー"
13： Exit Sub
14： End If
15：
16： ' ユーザーが選択した検索列に対応するColumnオブジェクトの番号を取得する
17： searchfield = COMBO_SEARCHFIELD.ItemData(searchfield)
18： ' ユーザーが選択した検索列に対応するg_objRec変数が指す
19： ' ADODB.Recordsetオブジェクトに対応するフィールド名を取得する
20： fieldname = DGrid_Customer.Columns(searchfield).DataField
21：
22： ' 検索方向の取得
23： If OPT_UP.Value = True Then
24： ' 上方向のサーチ
25： order = adSearchBackward
26： Else
27： ' 下方向のサーチ
28： order = adSearchForward
29： End If
30：
31： ' 検索文字列を取得する
32： searchStr = TXT_SEARCH.Text
33：
34： ' 検索対象となるフィールドの型を調べる
35： ' ここでは，データベースエンジンとして
36： ' SQL Server 7.0もしくはMSDEのみを対象とする
37：
38： Select Case g_objRec.Fields(fieldname).Type
39： Case adChar, adVarChar, adWChar, adVarWChar
40： ' 文字列である
41： ' like演算子による検索とする
42： FindStr = fieldname & " like " & "'" & searchStr & "*'"
43： dateFlag = False
44： Case adDBTimeStamp
45： ' 日付／時刻である
46： ' 入力された日付や時刻のフォーマットが正しいかどうかを調べる
47： If Not IsDate(searchStr) Then
48： MsgBox "指定された検索文字列が正しい日付ではありません", _
vbOKOnly, "検索エラー"
49： Exit Sub
50： End If
51： ' =演算子による検索とする
52： ' ここで日付の形式が正しくなるようFormatDateTime関数を使う
53： searchStr = FormatDateTime(searchStr)
54： If TimeValue(searchStr) <> 0 Then
55： ' 時刻まで指定されているとき
56： ' = 演算子で検索する
57： FindStr = fieldname & " = " & "#" & searchStr & "#"
58： dateFlag = False
59： Else
60： ' 時刻は指定されていないとき
61： ' >= 演算子で検索する
62： FindStr = fieldname & " >= " & "#" & searchStr & "#"
63： dateFlag = True
64： End If
65： Case Else
66： ' 数値と思われる
67： ' 入力された数値が正しいかどうかを調べる
68： If Not IsNumeric(searchStr) Then
69： MsgBox "指定された検索文字列が正しい数値ではありません", _
vbOKOnly, "検索エラー"
70： Exit Sub
71： End If
72： ' =演算子による検索とする
73： FindStr = fieldname & " = " & searchStr
74： dateFlag = False
75： End Select
76：
77： ' 検索する
78： ' On Error Resume Nextを使うのは，
79： ' ユーザーが異常な検索文字列を渡したとしても
80： ' エラーとしないようにするため
81： On Error Resume Next
82：
83： If dateFlag = False Then
84： ' 日付ではないときの検索
85： g_objRec.Find FindStr, 1, order
86：
87： If Err.Number <> 0 Then
88： ' 何らかのエラーが発生した
89： MsgBox "指定された検索文字が不正です", vbOKOnly, "検索エラー"
90： Exit Sub
91： End If
92： Else
93： ' 日付であるときの検索
94： Do
95： g_objRec.Find FindStr, 1, order
96： If g_objRec.EOF Or g_objRec.BOF Then
97： Exit Do
98： End If
99： Loop While g_objRec.Fields(fieldname).Value >= DateAdd("d", 1, searchStr)
100： End If
101：
102： If g_objRec.BOF Then
103： ' BOFに達したということは，見つからなかったとき
104： MsgBox "指定された値は見つかりませんでした", vbOKOnly, "検索"
105： g_objRec.MoveFirst
106： End If
107：
108： If g_objRec.EOF Then
109： ' EOFに達したということは，見つからなかったとき
110： MsgBox "指定された値は見つかりませんでした", vbOKOnly, "検索"
111： g_objRec.MoveLast
112： End If
113：
114： End Sub