List 6-16　DataObj.GetRecordメソッド

  1： Public Sub GetRecord(ByVal CUSTOMERID As Long, _
   　                      ByRef NAME As Variant, ByRef YOMIGANA As Variant, _
   　                      ByRef ZIP As Variant, ByRef ADDRESS As Variant, _
   　                      ByRef TELEPHONE As Variant, ByRef FAX As Variant, _
   　                      ByRef BILLDAY As Variant, ByRef MEMO As Variant, _
   　                      ByRef MADEUSER As Variant, ByRef MADEDATE As Variant, _
   　                      ByRef LASTUSER As Variant, ByRef LASTDATE As Variant)
  2：     ' 顧客情報テーブル内の指定された顧客番号の顧客情報を返す
  3：     ' 【引数】
  4：     '   ID = 読み出したい顧客を特定する顧客番号を指定する
  5：     '   NAME = 指定された顧客の顧客名が格納される
  6：     '   YOMIGANA = 指定された顧客の顧客名のよみがなが格納される
  7：     '   ZIP = 指定された顧客の郵便番号が格納される
  8：     '   ADDRESS = 指定された顧客の住所が格納される
  9：     '   TELEPHONE = 指定された顧客の電話番号が格納される
 10：     '   FAX = 指定された顧客のFAX番号が格納される
 11：     '   BILLDAY = 指定された顧客の請求の締め日が格納される
 12：     '   MEMO = 指定された顧客の摘要が格納される
 13：     '   MADEUSER = 指定された顧客を作成したユーザー名が格納される
 14：     '   MADEDATE = 指定された顧客が作成された日時が格納される
 15：     '   LASTUSER = 指定された顧客の最終更新ユーザー名が格納される
 16：     '   LASTDATE = 指定された顧客の最終更新日時が格納される
 17：     ' 【戻り値】
 18：     '   なし
 19：     Dim objContext As ObjectContext
 20：     Dim objRec As ADODB.Recordset
 21：     
 22：     ' オブジェクトコンテキストの取得
 23：     Set objContext = GetObjectContext()
 24：     
 25：     ' エラーハンドラの設定
 26：     On Error GoTo ErrHandle
 27：     
 28：     ' 指定された顧客番号の顧客情報を得る
 29：     Set objRec = CreateObject("ADODB.Recordset")
 30：     objRec.Open "SELECT * FROM 顧客情報 WHERE ID=" & CUSTOMERID, _
   　                 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：     NAME = objRec.Fields("NAME").Value
 38：     YOMIGANA = objRec.Fields("YOMIGANA").Value
 39：     ZIP = objRec.Fields("ZIP").Value
 40：     ADDRESS = objRec.Fields("ADDRESS").Value
 41：     TELEPHONE = objRec.Fields("TELEPHONE").Value
 42：     FAX = objRec.Fields("FAX").Value
 43：     BILLDAY = objRec.Fields("BILLDAY").Value
 44：     MEMO = objRec.Fields("MEMO").Value
 45：     MADEUSER = objRec.Fields("MADEUSER").Value
 46：     MADEDATE = objRec.Fields("MADEDATE").Value
 47：     LASTUSER = objRec.Fields("LASTUSER").Value
 48：     LASTDATE = objRec.Fields("LASTDATE").Value
 49：     
 50：     ' データベースとの接続を閉じてレコードセットを解放
 51：     objRec.Close
 52：     Set objRec = Nothing
 53：     
 54：     ' コミットする
 55：     objContext.SetComplete
 56：     
 57：     ' オブジェクトコンテキストの解放
 58：     Set objContext = Nothing
 59：     
 60：     Exit Sub
 61： 
 62： ErrHandle:
 63：     ' エラーハンドラ
 64：     objContext.SetAbort
 65：     Set objContext = Nothing
 66：     Set objRec = Nothing
 67：     
 68：     ' エラーの再発行
 69：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 70： End Sub