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