List 7-83 FormProductフォームの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_Product.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： Select Case g_objRec.Fields(fieldname).Type
38： Case adChar, adVarChar, adWChar, adVarWChar
39： ' 文字列である
40： ' like演算子による検索とする
41： FindStr = fieldname & " like " & "'" & searchStr & "*'"
42： dateFlag = False
43： Case adDBTimeStamp
44： ' 日付／時刻である
45： ' 入力された日付や時刻のフォーマットが正しいかどうかを調べる
46： If Not IsDate(searchStr) Then
47： MsgBox "指定された検索文字列が正しい日付ではありません", _
vbOKOnly, "検索エラー"
48： Exit Sub
49： End If
50： ' =演算子による検索とする
51： ' ここで日付の形式が正しくなるようFormatDateTime関数を使う
52： searchStr = FormatDateTime(searchStr)
53： If TimeValue(searchStr) <> 0 Then
54： ' 時刻まで指定されているとき
55： ' = 演算子で検索する
56： FindStr = fieldname & " = " & "#" & searchStr & "#"
57： dateFlag = False
58： Else
59： ' 時刻は指定されていないとき
60： ' >= 演算子で検索する
61： FindStr = fieldname & " >= " & "#" & searchStr & "#"
62： dateFlag = True
63： End If
64： Case Else
65： ' 数値と思われる
66： ' 入力された数値が正しいかどうかを調べる
67： If Not IsNumeric(searchStr) Then
68： MsgBox "指定された検索文字列が正しい数値ではありません", _
vbOKOnly, "検索エラー"
69： Exit Sub
70： End If
71： ' =演算子による検索とする
72： FindStr = fieldname & " = " & searchStr
73： dateFlag = False
74： End Select
75：
76： ' 検索する
77： ' On Error Resume Nextを使うのは，
78： ' ユーザーが異常な検索文字列を渡したとしても
79： ' エラーとしないようにするための処理
80： On Error Resume Next
81：
82： If dateFlag = False Then
83： ' 日付ではないときの検索
84： g_objRec.Find FindStr, 1, order
85：
86： If Err.NUMBER <> 0 Then
87： ' 何らかのエラーが発生した
88： MsgBox "指定された検索文字が不正です", vbOKOnly, _
"検索エラー"
89： Exit Sub
90： End If
91： Else
92： ' 日付であるときの検索
93： Do
94： g_objRec.Find FindStr, 1, order
95： If g_objRec.EOF Or g_objRec.BOF Then
96： Exit Do
97： End If
98： Loop While g_objRec.Fields(fieldname).Value >= _
DateAdd("d", 1, searchStr)
99： End If
100：
101： If g_objRec.BOF Then
102： ' BOFに達したということは，見つからなかったとき
103： MsgBox "指定された値は見つかりませんでした", vbOKOnly, "検索"
104： g_objRec.MoveFirst
105： End If
106：
107： If g_objRec.EOF Then
108： ' EOFに達したということは，見つからなかったとき
109： MsgBox "指定された値は見つかりませんでした", vbOKOnly, "検索"
110： g_objRec.MoveLast
111： End If
112： End Sub