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

  1： Public Function GetRecord(ByVal SlipID As Long, _
   　                           ByRef DIVISION As Variant, _
   　                           ByRef PERSON As Variant, _
   　                           ByRef DELIVERDATE As Variant, _
   　                           ByRef SENT_ADDR As Variant, _
   　                           ByRef SENT_TEL As Variant, _
   　                           ByRef MEMO As Variant, _
   　                           ByRef MADEDATE As Variant, _
   　                           ByRef MADEUSER As Variant, _
   　                           ByRef LASTDATE As Variant, _
   　                           ByRef LASTUSER As Variant) As Long
  2：     ' 指定された伝票番号に結び付けられた
  3：     ' 伝票追加情報テーブル中のレコードの内容を返す
  4：     ' 【引数】
  5：     '   SlipID = 読み出したい伝票を特定する伝票番号を指定する
  6：     '   DIVISION = 伝票に結び付けられた顧客の部署名が格納される
  7：     '   PERSON = 伝票に結び付けられた顧客の担当者名が格納される
  8：     '   DELIVERDATE = 伝票に結び付けられた納入予定日が格納される
  9：     '   SENT_ADDR = 伝票に結び付けられた発送先の住所が格納される
 10：     '   SENT_TEL = 伝票に結び付けられた発送先の電話番号が格納される
 11：     '   MEMO = 伝票に結び付けられた摘要が格納される
 12：     '   MADEDATE = 伝票追加情報を作った日時が格納される
 13：     '   MADEUSER = 伝票追加情報を作ったユーザーのアカウント名が格納される
 14：     '   LASTDATE = 最終更新日が格納される
 15：     '   LASTUSER = 最終更新ユーザー名が格納される
 16：     ' 【戻り値】
 17：     '   このレコードのレコードID
 18：     Dim objContext As ObjectContext
 19：     Dim objRec As ADODB.Recordset
 20：     
 21：     ' オブジェクトコンテキストの取得
 22：     Set objContext = GetObjectContext()
 23：     
 24：     ' エラーハンドラの設定
 25：     On Error GoTo ErrHandle
 26：     
 27：     ' 指定された伝票番号と一致する伝票に結び付けられた
 28：     ' 伝票追加情報のレコードを取得
 29：     Set objRec = CreateObject("ADODB.Recordset")
 30：     objRec.Open "SELECT * FROM 伝票追加情報 WHERE SLIPID=" & SlipID & _
   　                 " AND DELETEDFLAG=0", _
   　                 g_DBConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
 31：     
 32：     If objRec.EOF Then
 33：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
   　                   "指定された伝票番号と一致する伝票が見つかりません"
 34：     End If
 35：     
 36：     ' 取得したデータを戻り値に設定
 37：     DIVISION = objRec.Fields("DIVISION").Value
 38：     PERSON = objRec.Fields("PERSON").Value
 39：     DELIVERDATE = objRec.Fields("DELIVERDATE").Value
 40：     SENT_ADDR = objRec.Fields("SENT_ADDR").Value
 41：     SENT_TEL = objRec.Fields("SENT_TEL").Value
 42：     MEMO = objRec.Fields("MEMO").Value
 43：     MADEDATE = objRec.Fields("MADEDATE").Value
 44：     MADEUSER = objRec.Fields("MADEUSER").Value
 45：     LASTDATE = objRec.Fields("LASTDATE").Value
 46：     LASTUSER = objRec.Fields("LASTUSER").Value
 47：     
 48：     ' 戻り値を設定
 49：     GetRecord = objRec.Fields("ID").Value
 50：     
 51：     ' データベースとの接続を閉じてレコードセットを解放
 52：     objRec.Close
 53：     Set objRec = Nothing
 54：     
 55：     ' トランザクションをコミット
 56：     objContext.SetComplete
 57：     
 58：     ' オブジェクトコンテキストの解放
 59：     Set objContext = Nothing
 60：     
 61：     Exit Function
 62： 
 63： ErrHandle:
 64：     ' エラーハンドラ
 65：     objContext.SetAbort
 66：     
 67：     Set objContext = Nothing
 68：     Set objRec = Nothing
 69：     
 70：     GetRecord = -1
 71：     
 72：     ' エラーの再発行
 73：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 74： End Function