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

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