List 5-9　chkStockメソッドの実装

  1： Public Function checkStock(ByVal ProductID As Long) As Long
  2：     'ProductIDで指定されたIDをもつ製品の在庫数を返す
  3：     Dim objCon As ADODB.Connection
  4：     Dim objRec As ADODB.Recordset
  5：     Dim Stock As Long
  6：     Dim objContext As ObjectContext
  7：     
  8：     
  9：     'オブジェクトコンテキストを取得
 10：     Set objContext = GetObjectContext()
 11：     
 12：     'エラーハンドラを設定
 13：     On Error GoTo ErrorHandler
 14：     
 15：     
 16：     'コネクションオブジェクトの作成
 17：     Set objCon = CreateObject("ADODB.Connection")
 18：     
 19：     'データベースを開く
 20：     objCon.Open "Driver=SQL Server; Server=(local); UID=sa;" & _
   　                 " Database=dbsample"
 21：     
 22：     '在庫テーブルを開き，指定されたテーブルの在庫を取得する
 23：     Set objRec = objCon.Execute("SELECT STOCK FROM 在庫テーブル" & _
   　                                 " WHERE ID=" & ProductID)
 24：     If objRec.EOF Then
 25：         '在庫が見つからない
 26：         Err.Raise 1 + 513 + vbObjectError, "checkStock", _
   　                   "指定された製品は見つかりません"
 27：         Exit Function
 28：     End If
 29：     
 30：     '在庫の取得
 31：     Stock = objRec.Fields("STOCK")
 32：     checkStock = Stock
 33：     
 34：     'レコードセットを閉じて破棄
 35：     objRec.Close
 36：     Set objRec = Nothing
 37：     
 38：     'コネクションを閉じて破棄
 39：     objCon.Close
 40：     Set objCon = Nothing
 41：     
 42：     'トランザクションをコミット
 43：     objContext.SetComplete
 44：     
 45：     Exit Function
 46：     
 47： ErrorHandler:
 48：     'エラーハンドラ
 49：     'エラーが発生したときには，トランザクションをアボートに設定
 50：     objContext.SetAbort
 51：     'エラーをもう一回引き起こす
 52：     Err.Raise Err.Number, Err.Source, Err.Description
 53： End Function