List 6-62　DataObj.SlipDetailコンポーネントの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