List 6-82　DataObj.StockコンポーネントのInStockメソッド

  1： Public Function InStock(ByVal StockID As Long) As Boolean
  2：     ' 指定されたレコードIDを持つレコードが入庫なのか出庫なのかを返す
  3：     ' 【引数】
  4：     '   StockID = 取得したいレコードを特定するレコードID（IDフィールドの値）
  5：     ' 【戻り値】
  6：     '   指定されたレコードが入庫を示せばTrue，出庫を示せばFalseを返す
  7：     Dim objContext As ObjectContext
  8：     Dim objConn As ADODB.Connection
  9：     Dim objRec As ADODB.Recordset
 10：     
 11：     ' オブジェクトコンテキストの取得
 12：     Set objContext = GetObjectContext()
 13：     
 14：     ' エラーハンドラの設定
 15：     On Error GoTo ErrHandle
 16：     
 17：     ' データベースに接続して，指定されたレコードの
 18：     ' SLIPIDフィールドの値を調べる
 19：     Set objConn = CreateObject("ADODB.Connection")
 20：     objConn.Open g_DBConnection
 21：     Set objRec = objConn.Execute("SELECT SLIPID FROM 在庫情報 WHERE ID=" & _
   　                                  StockID)
 22：     
 23：     If objRec.EOF Then
 24：         ' 指定されたレコードがない
 25：         Err.Raise Err_NOTFOUND, App.Title, _
   　                   "指定された入庫または出庫予定が見つかりません"
 26：     Else
 27：         If IsNull(objRec.Fields("SLIPID").Value) Then
 28：             ' 入庫レコード
 29：             InStock = True
 30：         Else
 31：             ' 出庫レコード
 32：             InStock = False
 33：         End If
 34：     End If
 35：     
 36：     ' データベースとの接続を閉じてレコードセットを解放
 37：     Set objRec = Nothing
 38：     objConn.Close
 39：     Set objConn = Nothing
 40：     
 41：     ' コミットする
 42：     objContext.SetComplete
 43：     
 44：     ' オブジェクトコンテキストの解放
 45：     Set objContext = Nothing
 46：     
 47：     Exit Function
 48： 
 49： ErrHandle:
 50：     ' エラーハンドラ
 51：     objContext.SetAbort
 52：     Set objContext = Nothing
 53：     Set objConn = Nothing
 54：     Set objRec = Nothing
 55：     
 56：     ' エラーの再発行
 57：     Err.Raise Err.NUMBER, Err.Source, Err.Description,_
   　               Err.HelpFile, Err.HelpContext
 58： End Function