List 6-56　DataObj.ProductコンポーネントのGetRecordメソッド

  1： Public Sub GetRecord(ByVal ProductID As Long, _
   　                      ByRef PRODUCTNAME As Variant, ByRef YOMIGANA As Variant, _
   　                      ByRef PRICE As Variant, ByRef STOCK As Variant, _
   　                      ByRef MEMO As Variant, ByRef BACKORDER As Variant, _
   　                      ByRef MADEUSER As Variant, ByRef MADEDATE As Variant, _
   　                      ByRef LASTUSER As Variant, ByRef LASTDATE As Variant)
  2：     ' 製品情報テーブル内の指定された製品番号の製品情報を返す
  3：     ' 【引数】
  4：     '   ProductID = 読み出したい製品を特定する製品番号を指定する
  5：     '   PRODUCTNAME = 指定された製品の製品名が格納される
  6：     '   YOMIGANA = 指定された製品の製品名のよみがなが格納される
  7：     '   PRICE = 指定された製品の価格が格納される
  8：     '   STOCK = 指定された製品の在庫数が格納される
  9：     '   MEMO = 指定された製品の摘要が格納される
 10：     '   BACKORDER = 指定された製品の予約数が格納される
 11：     '   MADEUSER = 指定された製品を登録したユーザー名が格納される
 12：     '   MADEDATE = 指定された製品が登録された日時が格納される
 13：     '   LASTUSER = 指定された製品の最終更新ユーザー名が格納される
 14：     '   LASTDATE = 指定された製品の最終更新日時が格納される
 15：     ' 【戻り値】
 16：     '   なし
 17：     Dim objContext As ObjectContext
 18：     Dim objRec As ADODB.Recordset
 19：     
 20：     ' オブジェクトコンテキストの取得
 21：     Set objContext = GetObjectContext()
 22：     
 23：     ' エラーハンドラの設定
 24：     On Error GoTo ErrHandle
 25：     
 26：     ' 指定された製品番号の製品情報を得る
 27：     Set objRec = CreateObject("ADODB.Recordset")
 28：     objRec.Open "SELECT * FROM 製品情報 WHERE ID=" & ProductID, _
   　                 g_DBConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
 29：     
 30：     If objRec.EOF Then
 31：         Err.Raise Errorcode.Err_NotFound, App.Title, _
   　                   "指定された製品番号を持つ製品が見つかりません"
 32：     End If
 33：     
 34：     ' 取得したデータを戻り値に設定
 35：     PRODUCTNAME = objRec.Fields("PRODUCTNAME").Value
 36：     YOMIGANA = objRec.Fields("YOMIGANA").Value
 37：     PRICE = objRec.Fields("PRICE").Value
 38：     STOCK = objRec.Fields("STOCK").Value
 39：     MEMO = objRec.Fields("MEMO").Value
 40：     BACKORDER = objRec.Fields("BACKORDER").Value
 41：     MADEUSER = objRec.Fields("MADEUSER").Value
 42：     MADEDATE = objRec.Fields("MADEDATE").Value
 43：     LASTUSER = objRec.Fields("LASTUSER").Value
 44：     LASTDATE = objRec.Fields("LASTDATE").Value
 45：     
 46：     ' データベースとの接続を閉じてレコードセットを解放
 47：     objRec.Close
 48：     Set objRec = Nothing
 49：     
 50：     ' コミットする
 51：     objContext.SetComplete
 52：     
 53：     ' オブジェクトコンテキストの解放
 54：     Set objContext = Nothing
 55：     
 56：     Exit Sub
 57：     
 58： ErrHandle:
 59：     ' エラーハンドラ
 60：     objContext.SetAbort
 61：     Set objContext = Nothing
 62：     Set objRec = Nothing
 63：     
 64：     ' エラーの再発行
 65：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 66： End Sub