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