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

  1： Public Sub GetRecord(ByVal StockID As Long, _
   　                      ByRef WillDate As Variant, _
   　                      ByRef DUEDATE As Variant, _
   　                      ByRef CONFIRMEDFLAG As Variant, _
   　                      ByRef PRODUCTID As Variant, _
   　                      ByRef NUMBER As Variant, _
   　                      ByRef MEMO As Variant, _
   　                      ByRef SLIPID As Variant, _
   　                      ByRef MADEUSER As Variant, _
   　                      ByRef MADEDATE As Variant, _
   　                      ByRef LASTUSER As Variant, _
   　                      ByRef LASTDATE As Variant)
  2：     ' 在庫情報テーブル中の指定されたレコードの情報を返す
  3：     ' 【引数】
  4：     '   StockID = 取得したいレコードを特定するレコードID（IDフィールドの値）を指定する
  5：     '   WillDate = 指定されたレコードの入庫または出庫予定日が格納される
  6：     '   DUEDATE = 指定されたレコードの入庫または出庫が施行された日時が格納される
  7：     '   CONFIRMEDFLAG = 指定されたレコードが施行されたかどうかのフラグが格納される
  8：     '   PRODUCTID = 指定されたレコードが指し示している製品の製品番号が格納される
  9：     '   NUMBER = 指定されたレコードが指し示している製品の入庫または出庫数が格納される
 10：     '   MEMO = 指定されたレコードの摘要が格納される
 11：     '   SLIPID = 指定されたレコードに結びつけられている伝票の伝票番号が格納される
 12：     '   MADEUSER = 指定されたレコードを作成したユーザー名が格納される
 13：     '   MADEDATE = 指定されたレコードが作成された日時が格納される
 14：     '   LASTUSER = 指定されたレコードの最終更新ユーザー名が格納される
 15：     '   LASTDATE = 指定されたレコードの最終更新日時が格納される
 16：     ' 【戻り値】
 17：     '   なし
 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：     Set objRec = CreateObject("ADODB.Recordset")
 29：     objRec.Open "SELECT * FROM 在庫情報 WHERE ID=" & _
   　                 StockID, g_DBConnection, _
   　                 adOpenForwardOnly, adLockReadOnly, adCmdText
 30：     
 31：     If objRec.EOF Then
 32：         Err.Raise Errorcode.Err_NotFound, App.Title, _
   　                   "指定された入庫または出庫予定が見つかりません"
 33：     End If
 34：     
 35：     ' 取得したデータを戻り値に設定
 36：     WillDate = objRec.Fields("DATE").Value
 37：     DUEDATE = objRec.Fields("DUEDATE").Value
 38：     CONFIRMEDFLAG = objRec.Fields("CONFIRMEDFLAG").Value
 39：     PRODUCTID = objRec.Fields("PRODUCTID").Value
 40：     NUMBER = objRec.Fields("NUMBER").Value
 41：     MEMO = objRec.Fields("MEMO").Value
 42：     SLIPID = objRec.Fields("SLIPID").Value
 43：     MADEUSER = objRec.Fields("MADEUSER").Value
 44：     MADEDATE = objRec.Fields("MADEDATE").Value
 45：     LASTUSER = objRec.Fields("LASTUSER").Value
 46：     LASTDATE = objRec.Fields("LASTDATE").Value
 47：     
 48：     ' データベースとの接続を閉じてレコードセットを解放
 49：     objRec.Close
 50：     Set objRec = Nothing
 51：     
 52：     ' コミットする
 53：     objContext.SetComplete
 54：     
 55：     ' オブジェクトコンテキストの解放
 56：     Set objContext = Nothing
 57：     
 58：     Exit Sub
 59： 
 60： ErrHandle:
 61：     ' エラーハンドラ
 62：     objContext.SetAbort
 63：     Set objContext = Nothing
 64：     Set objRec = Nothing
 65：     
 66：     ' エラーの再発行
 67：     Err.Raise Err.NUMBER, Err.Source, _
   　               Err.Description, Err.HelpFile, Err.HelpContext
 68： End Sub