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

  1： Private Sub Chk_ProductID(ProductID As Variant)
  2：     ' 製品番号が正しいかどうかを調査
  3：     If IsNull(ProductID) Then
  4：         Err.Raise Errorcode.Err_PRODUCTID, App.Title, _
   　                   "製品番号が設定されていません"
  5：     Else
  6：         If Not IsNumeric(ProductID) Then
  7：             Err.Raise Errorcode.Err_PRODUCTID, App.Title, _
   　                       "製品番号が正しい数値でありません"
  8：         End If
  9：     End If
 10： End Sub
 11： 
 12： Private Sub Chk_NUMBER(NUMBER As Variant)
 13：     ' 数量が正しいかどうかを調査
 14：     If IsNull(NUMBER) Then
 15：         Err.Raise Errorcode.Err_NUMBER, App.Title, _
   　                   "数量が設定されていません"
 16：     Else
 17：         If Not IsNumeric(NUMBER) Then
 18：             Err.Raise Errorcode.Err_PRODUCTID, App.Title, _
   　                       "数量が正しい数値ではありません"
 19：         End If
 20：     End If
 21： End Sub
 22： 
 23： Private Sub Chk_PRICE(PRICE As Variant)
 24：     ' 価格が正しいかどうかを調査
 25：     If IsNull(PRICE) Then
 26：         Err.Raise Errorcode.Err_PRICE, App.Title, _
   　                   "価格が設定されていません"
 27：     Else
 28：         If Not IsNumeric(PRICE) Then
 29：             Err.Raise Errorcode.Err_PRICE, App.Title, _
   　                       "価格が正しい数値ではありません"
 30：         End If
 31：     End If
 32： End Sub
 33： 
 34： Private Sub Chk_MEMO(ByRef MEMO As Variant)
 35：     ' 摘要が正しいかどうかを調査
 36：     If Not IsNull(MEMO) Then
 37：         If Len(MEMO) > 80 Then
 38：             Err.Raise Errorcode.Err_MEMOTOOLONG, App.Title, _
   　                       "摘要は80文字以内でなければなりません"
 39：         End If
 40：     End If
 41： End Sub
 42： 
 43： Private Sub Chk_SLIPID(ByRef SlipID As Variant)
 44：     ' 伝票番号が正しいかどうかを調査
 45：     If IsNull(SlipID) Then
 46：         Err.Raise Errorcode.Err_SLIPID, App.Title, _
   　                   "伝票番号が不正です"
 47：     Else
 48：         If Not IsNumeric(SlipID) Then
 49：             Err.Raise Errorcode.Err_SLIPID, App.Title, _
   　                       "伝票番号が有効な数字ではありません"
 50：         End If
 51：     End If
 52： End Sub
 53： 
 54： Public Function AddRecord(ByVal ProductID As Variant, _
   　                           ByVal NUMBER As Variant, _
   　                           ByVal UNITPRICE As Variant, _
   　                           ByVal PRICE As Variant, _
   　                           ByVal MEMO As Variant, _
   　                           ByVal SlipID As Variant) As Long
 55：     ' 明細情報テーブルに新しいレコードを追加
 56：     ' 【引数】
 57：     '   ProductID = 明細の対象となる製品の製品番号
 58：     '   NUMBER = 数量
 59：     '   UNITPRICE = 製品単価
 60：     '   PRICE = 製品価格
 61：     '   MEMO = 摘要
 62：     '   SlipID = 結び付ける伝票の伝票番号
 63：     ' 【戻り値】
 64：     ' 追加した明細を示すレコードID（IDフィールドに設定された値）
 65：     Dim objContext As ObjectContext
 66：     Dim objRec As ADODB.Recordset
 67：     Dim userName As String, NowDate As Date
 68：     
 69：     ' オブジェクトコンテキストの取得
 70：     Set objContext = GetObjectContext()
 71：     
 72：     ' エラーハンドラの設定
 73：     On Error GoTo ErrHandle
 74：     
 75：     ' ユーザー名と現在の時刻を取得
 76：     userName = objContext.Security.GetOriginalCallerName()
 77：     NowDate = Now()
 78：     
 79：     ' 与えられた引数が正しいかどうかをチェック
 80：     Chk_ProductID ProductID
 81：     Chk_NUMBER NUMBER
 82：     Chk_PRICE UNITPRICE
 83：     Chk_PRICE PRICE
 84：     Chk_MEMO MEMO
 85：     Chk_SLIPID SlipID
 86：     
 87：     ' データベースと接続して，書き込み可能なレコードセットを取得
 88：     Set objRec = CreateObject("ADODB.Recordset")
 89：     objRec.Open "明細情報", g_DBConnection, adOpenKeyset, _
   　                  adLockPessimistic, adCmdTable
 90：     
 91：     ' 新しいレコードを追加
 92：     objRec.AddNew
 93：     
 94：     ' レコードにデータを設定
 95：     objRec.Fields("PRODUCTID").Value = ProductID
 96：     objRec.Fields("NUMBER").Value = NUMBER
 97：     objRec.Fields("UNITPRICE").Value = UNITPRICE
 98：     objRec.Fields("PRICE").Value = PRICE
 99：     objRec.Fields("MEMO").Value = MEMO
100：     objRec.Fields("SLIPID").Value = SlipID
101：     objRec.Fields("MADEUSER").Value = userName
102：     objRec.Fields("MADEDATE").Value = NowDate
103：     objRec.Fields("LASTUSER").Value = userName
104：     objRec.Fields("LASTDATE").Value = NowDate
105：     objRec.Fields("DELETEDFLAG").Value = False
106：     
107：     ' データベースに反映
108：     objRec.Update
109：     
110：     ' 追加したレコードIDを戻り値として設定
111：     AddRecord = objRec.Fields("ID").Value
112：     
113：     ' データベースとの接続を閉じてレコードセットを解放
114：     objRec.Close
115：     Set objRec = Nothing
116：     
117：     ' トランザクションをコミット
118：     objContext.SetComplete
119：     
120：     ' オブジェクトコンテキストの解放
121：     Set objContext = Nothing
122：     
123：     Exit Function
124： 
125： ErrHandle:
126：     ' エラーハンドラ
127：     objContext.SetAbort
128：     
129：     Set objContext = Nothing
130：     Set objRec = Nothing
131：     
132：     ' エラーの再発行
133：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
134： End Function