List 6-130　DataObj.SlipDetailコンポーネントのGetRecordsメソッド

  1： Public Function GetRecords(ByVal SlipID As Long) As ADODB.Recordset
  2：     ' 指定された伝票に付随する明細すべてをADODB.Recordsetオブジェクトとして返す
  3：     ' 【引数】
  4：     '   SlipID = 伝票を特定する伝票番号
  5：     ' 【戻り値】
  6：     '   その伝票に結び付けられている明細すべてを含むADODB.Recordsetオブジェクト
  7：     '   戻り値となるADODB.Recordsetオブジェクトは読み取り専用の閉じたレコードセット
  8：     Dim objContext As ObjectContext
  9：     Dim objRec As ADODB.Recordset
 10：     Dim strQuery As String
 11：     
 12：     ' オブジェクトコンテキストの取得
 13：     Set objContext = GetObjectContext()
 14：     
 15：     ' エラーハンドラの設定
 16：     On Error GoTo ErrHandle
 17：     
 18：     ' 発行するSELECT文
 19：     strQuery = "SELECT 明細情報.ID As ID, 明細情報.PRODUCTID As PRODUCTID," & _
   　                       "製品情報.PRODUCTNAME As PRODUCTNAME, 明細情報.NUMBER As NUMBER," & _
   　                       "明細情報.UNITPRICE As UNITPRICE, 明細情報.PRICE As PRICE," & _
   　                       "明細情報.MEMO As MEMO, 明細情報.SLIPID As SLIPID," & _
   　                       "明細情報.MADEUSER As MADEUSER, 明細情報.MADEDATE As MADEDATE," & _
   　                       "明細情報.LASTUSER As LASTUSER, 明細情報.LASTDATE As LASTDATE," & _
   　                       "明細情報.DELETEDFLAG As DELETEDFLAG" & _
   　                "  From 明細情報, 製品情報" & _
   　                "  Where 明細情報.PRODUCTID = 製品情報.ID" & _
   　                "        AND 明細情報.SLIPID =" & SlipID
 20： 
 21：     ' データベースと接続し，SELECT文を発行
 22：     Set objRec = CreateObject("ADODB.Recordset")
 23：     ' カーソルロケーションをクライアントカーソルに設定
 24：     objRec.CursorLocation = adUseClient
 25：     
 26：     ' SELECT文の実行
 27：     objRec.Open strQuery, g_DBConnection, adOpenStatic, adLockReadOnly, adCmdText
 28：     
 29：     ' データベースコネクションを切除
 30：     Set objRec.ActiveConnection = Nothing
 31：     
 32：     ' 取得したレコードセットを戻り値とする
 33：     Set GetRecords = objRec
 34：     Set objRec = Nothing
 35：     
 36：     ' トランザクションをコミット
 37：     objContext.SetComplete
 38：     
 39：     ' オブジェクトコンテキストの解放
 40：     Set objContext = Nothing
 41：     
 42：     Exit Function
 43： ErrHandle:
 44：     ' エラーハンドラ
 45：     objContext.SetAbort
 46：     Set objContext = Nothing
 47：     Set objRec = Nothing
 48：     
 49：     ' エラーの再発行
 50：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 51： End Function