List 6-97　DataObj.SlipコンポーネントのGetRecord_Slipメソッド

  1： Public Sub GetRecord_Slip(ByVal SlipID As Long, _
   　                           ByRef CUSTOMERID As Variant, _
   　                           ByRef SUBTOTAL As Variant, _
   　                           ByRef TAX As Variant, _
   　                           ByRef TOTAL As Variant, _
   　                           ByRef MADEDATE As Variant, _
   　                           ByRef MADEUSER As Variant, _
   　                           ByRef LASTDATE As Variant, _
   　                           ByRef LASTUSER As Variant)
  2：     ' 伝票情報テーブル内の指定された伝票番号の伝票のうち
  3：     ' 基本的な事項を返す
  4：     ' 【引数】
  5：     '   SlipID = 情報を読み出したい伝票を特定する伝票番号を指定する
  6：     '   CUSTOMERID = 指定された伝票の顧客番号が格納される
  7：     '   SUBTOTAL = 指定された伝票の小計が格納される
  8：     '   TAX = 指定された伝票の消費税が格納される
  9：     '   TOTAL = 指定された伝票の合計が格納される
 10：     '   MADEDATE = 指定された伝票の起票日が格納される
 11：     '   MADEUSER = 指定された伝票を起票したユーザーの
 12：     '              アカウント名が格納される
 13：     '   LASTDATE = 指定された伝票の最終更新日時が格納される
 14：     '   LASTUSER = 指定たれさ伝票の最終更新ユーザー名が格納される
 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=" & SlipID, _
   　                  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：     CUSTOMERID = objRec.Fields("CUSTOMERID").Value
 36：     SUBTOTAL = objRec.Fields("SUBTOTAL").Value
 37：     TAX = objRec.Fields("TAX").Value
 38：     TOTAL = objRec.Fields("TOTAL").Value
 39：     MADEDATE = objRec.Fields("MADEDATE").Value
 40：     MADEUSER = objRec.Fields("MADEUSER").Value
 41：     LASTDATE = objRec.Fields("LASTDATE").Value
 42：     LASTUSER = objRec.Fields("LASTUSER").Value
 43：     
 44：     ' データベースとの接続を閉じてレコードセットを解放
 45：     objRec.Close
 46：     Set objRec = Nothing
 47：     
 48：     ' トランザクションをコミット
 49：     objContext.SetComplete
 50：     
 51：     ' オブジェクトコンテキストの解放
 52：     Set objContext = Nothing
 53：     
 54：     Exit Sub
 55：     
 56： ErrHandle:
 57：     ' エラーハンドラ
 58：     objContext.SetAbort
 59：     
 60：     Set objContext = Nothing
 61：     Set objRec = Nothing
 62：     
 63：     ' エラーの再発行
 64：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 65： End Sub