List 6-27 DataObj.SlipコンポーネントのIsExistsCustomerメソッド
1: ' データベース接続文字列
2: Dim g_DBConnection As String
3:
4: Public Function IsExistsCustomer(ByRef CustomerID As Long) As Boolean
5: ' 引数CustomerIDを使っている伝票が存在するかどうかを調べる
6: ' 【引数】
7: ' CustomerID = 調べたい顧客を示す顧客番号
8: ' 【戻り値】
9: ' 指定された顧客をもつ伝票が存在するならばTrue,存在しなければFalseを返す
10: Dim objContext As ObjectContext
11: Dim objConn As ADODB.Connection
12: Dim objRec As ADODB.Recordset
13:
14: ' オブジェクトコンテキストの取得
15: Set objContext = GetObjectContext()
16:
17: ' エラーハンドラの設定
18: On Error GoTo ErrHandle
19:
20: ' 指定された顧客番号を使っている伝票が存在するかどうかを調べる
21: Set objConn = CreateObject("ADODB.Connection")
22: objConn.Open g_DBConnection
23: Set objRec = objConn.Execute("SELECT * FROM 伝票情報 WHERE CUSTOMERID=" & _
CustomerID & " AND DELETEDFLAG=0")
24: If objRec.EOF Then
25: ' 指定された顧客はいない
26: IsExistsCustomer = False
27: Else
28: ' 指定された顧客がいる
29: IsExistsCustomer = True
30: End If
31:
32: objRec.Close
33:
34: ' データベースとの接続を切断する
35: Set objRec = Nothing
36: objConn.Close
37: Set objConn = Nothing
38:
39: ' コミットする
40: objContext.SetComplete
41:
42: ' オブジェクトコンテキストの解放
43: Set objContext = Nothing
44:
45: Exit Function
46:
47: ErrHandle:
48: ' エラーハンドラ
49: objContext.SetAbort
50: Set objContext = Nothing
51: Set objConn = Nothing
52: Set objRec = Nothing
53:
54: ' エラーの再発行
55: Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
56: End Function