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