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