List 6-53　DataObj.ProductコンポーネントのAddRecordメソッド

  1： ' エラー処理関数群
  2： Private Sub Chk_PRODUCTNAME(ByRef PRODUCTNAME As Variant)
  3：     ' 製品名が正しいかどうか調べる
  4：     If IsNull(PRODUCTNAME) Then
  5：         Err.Raise Errorcode.Err_NAMETOOLONG, App.Title, _
   　                   "製品名に値が設定されていません"
  6：     End If
  7：     If Len(PRODUCTNAME) > 64 Then
  8：         Err.Raise Errorcode.Err_NAMETOOLONG, App.Title, _
   　                   "製品名は64文字以内でなければなりません"
  9：     End If
 10： End Sub
 11： 
 12： Private Sub Chk_YOMIGANA(ByRef YOMIGANA As Variant)
 13：     ' よみがなが正しいかどうかを調べる
 14：     If Len(YOMIGANA) > 80 Then
 15：         Err.Raise Errorcode.Err_YOMIGANATOOLONG, App.Title, _
   　                   "よみがなは80文字以内でなければなりません"
 16：     End If
 17： End Sub
 18： 
 19： Private Sub Chk_PRICE(ByRef PRICE As Variant)
 20：     ' 価格が正しいかどうかを調べる
 21：     If IsNull(PRICE) Then
 22：         Err.Raise Errorcode.Err_PRICE, App.Title, _
   　                   "価格が設定されていません"
 23：     End If
 24：     If Not IsNumeric(PRICE) Then
 25：         ' 正しい数値でない
 26：         Err.Raise Errorcode.Err_PRICE, App.Title, _
   　                   "価格が正しくありません"
 27：     End If
 28： End Sub
 29： 
 30： Private Sub Chk_MEMO(ByRef MEMO As Variant)
 31：     ' 摘要が正しいかどうかを調べる
 32：     If Len(MEMO) > 80 Then
 33：         Err.Raise Errorcode.Err_MEMOTOOLONG, App.Title, _
   　                   "摘要は80文字以内でなければなりません"
 34：     End If
 35： End Sub
 36： 
 37： ' データ処理する関数
 38： Public Function AddRecord(ByVal PRODUCTNAME As Variant, _
   　                           ByVal YOMIGANA As Variant, _
   　                           ByVal PRICE As Variant, _
   　                           ByVal MEMO As Variant) As Long
 39：     ' 製品情報テーブルに新しいレコードを加える
 40：     ' 【引数】
 41：     '   PRODUCTNAME = 製品名
 42：     '   YOMIGANA = 製品名よみがな
 43：     '   PRICE = 製品価格
 44：     '   MEMO = 摘要
 45：     ' 【戻り値】
 46：     '   登録した製品の製品番号（製品情報テーブルのIDフィールドの値）
 47：     Dim objContext As ObjectContext
 48：     Dim objRec As ADODB.Recordset
 49：     Dim userName As String, NowDate As Date
 50：     
 51：     ' オブジェクトコンテキストの取得
 52：     Set objContext = GetObjectContext()
 53：     
 54：     ' エラーハンドラの設定
 55：     On Error GoTo ErrHandle
 56：     
 57：     ' ユーザー名と現在の時刻を取得
 58：     userName = objContext.Security.GetOriginalCallerName()
 59：     NowDate = Now()
 60：     ' 与えられた引数が正しいかどうかをチェック
 61：     Chk_PRODUCTNAME PRODUCTNAME
 62：     Chk_YOMIGANA YOMIGANA
 63：     Chk_PRICE PRICE
 64：     Chk_MEMO MEMO
 65：     
 66：     ' データベースと接続して，書き込み可能なレコードセットを得る
 67：     Set objRec = CreateObject("ADODB.Recordset")
 68：     objRec.Open "製品情報", g_DBConnection, adOpenKeyset, _
   　                 adLockPessimistic, adCmdTable
 69：                 
 70：     ' 新しいレコードを追加
 71：     objRec.AddNew
 72：     
 73：     ' レコードにデータを設定
 74：     objRec.Fields("PRODUCTNAME").Value = PRODUCTNAME
 75：     objRec.Fields("YOMIGANA").Value = YOMIGANA
 76：     objRec.Fields("PRICE").Value = PRICE
 77：     objRec.Fields("STOCK").Value = 0    ' 在庫数の初期値は0に
 78：     objRec.Fields("MEMO").Value = MEMO
 79：     objRec.Fields("BACKORDER").Value = 0    ' 在庫予約数の初期値は0に
 80：     objRec.Fields("MADEUSER").Value = userName
 81：     objRec.Fields("MADEDATE").Value = NowDate
 82：     objRec.Fields("LASTUSER").Value = userName
 83：     objRec.Fields("LASTDATE").Value = NowDate
 84：     objRec.Fields("DELETEDFLAG").Value = 0
 85：     
 86：     ' データベースに反映
 87：     objRec.Update
 88：     
 89：     ' 作成した製品情報の製品番号を戻り値として設定する
 90：     AddRecord = objRec.Fields("ID").Value
 91：     
 92：     ' データベースとの接続を閉じてレコードセットを解放
 93：     objRec.Close
 94：     Set objRec = Nothing
 95：     
 96：     ' コミットする
 97：     objContext.SetComplete
 98：     
 99：     ' オブジェクトコンテキストの解放
100：     Set objContext = Nothing
101：     
102：     Exit Function
103：     
104： ErrHandle:
105：     ' エラーハンドラ
106：     objContext.SetAbort
107：     Set objContext = Nothing
108：     Set objRec = Nothing
109：     
110：     ' エラーの再発行
111：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
112： End Function