List 6-92 DataObj.SlipInformationコンポーネントのAddRecordメソッド
1: Private Sub Chk_SLIPID(ByRef SlipID As Variant)
2: ' 伝票番号が正しいかどうかを調べる
3: If IsNull(SlipID) Then
4: Err.Raise Errorcode.Err_SLIPID, App.Title, _
"伝票番号が不正です"
5: Else
6: If Not IsNumeric(SlipID) Then
7: Err.Raise Errorcode.Err_SLIPID, App.Title, _
"伝票番号が有効な数字ではありません"
8: End If
9: End If
10: End Sub
11:
12: Private Sub Chk_DIVISION(ByRef DIVISION As Variant)
13: ' 顧客の担当部署名が正しいかどうかを調べる
14: If Not IsNull(DIVISION) Then
15: If Len(DIVISION) > 64 Then
16: Err.Raise Errorcode.Err_DIVISION, App.Title, _
"担当部署名が長すぎます"
17: End If
18: End If
19: End Sub
20:
21: Private Sub Chk_PERSON(ByRef PERSON As Variant)
22: ' 顧客の担当者名が正しいかどうかを調べる
23: If Not IsNull(PERSON) Then
24: If Len(PERSON) > 64 Then
25: Err.Raise Errorcode.Err_PERSON, App.Title, _
"担当者名が長すぎます"
26: End If
27: End If
28: End Sub
29:
30: Private Sub Chk_DELIVERDATE(ByRef DELIVERDATE As Variant)
31: ' 納入予定日が正しいかどうかを調べる
32: If IsNull(DELIVERDATE) Then
33: Err.Raise Errorcode.Err_DELIVERDATE, App.Title, _
"納入予定日が設定されていません"
34: Else
35: If Not IsDate(DELIVERDATE) Then
36: Err.Raise Errorcode.Err_DELIVERDATE, App.Title, _
"納入予定日が不正です"
37: End If
38: End If
39: End Sub
40:
41: Private Sub Chk_SENT_ADDR(ByRef SENT_ADDR As Variant)
42: ' 発送先が正しいかどうかを調べる
43: If Not IsNull(SENT_ADDR) Then
44: If Len(SENT_ADDR) > 255 Then
45: Err.Raise Errorcode.Err_SENT_ADDR, App.Title, _
"発送先が長すぎます"
46: End If
47: End If
48: End Sub
49:
50: Private Sub Chk_SENT_TEL(ByRef SENT_TEL As Variant)
51: ' 発送先の電話番号が正しいかどうかを調べる
52: If Not IsNull(SENT_TEL) Then
53: If Len(SENT_TEL) > 32 Then
54: Err.Raise Errorcode.Err_SENT_TEL, App.Title, _
"発送先電話番号が長すぎます"
55: End If
56: End If
57: End Sub
58:
59: Private Sub Chk_MEMO(ByRef MEMO As Variant)
60: ' 摘要が正しいかどうかを調べる
61: If Not IsNull(MEMO) Then
62: If Len(MEMO) > 80 Then
63: Err.Raise Errorcode.Err_MEMOTOOLONG, App.Title, _
"摘要は80文字以内でなければなりません"
63: End If
64: End If
65: End Sub
66:
67: Public Function AddRecord(ByVal SlipID As Variant, _
ByVal DIVISION As Variant, _
ByVal PERSON As Variant, _
ByVal DELIVERDATE As Variant, _
ByVal SENT_ADDR As Variant, _
ByVal SENT_TEL As Variant, _
ByVal MEMO As Variant) As Long
68: ' 伝票追加情報テーブルに新しいレコードを加える
69: ' 【引数】
70: ' SlipID = 結び付ける伝票の伝票番号
71: ' DIVISION = 顧客の部署名
72: ' PERSON = 顧客の担当者名
73: ' DELIVERDATE = 納入予定日
74: ' SENT_ADDR = 発送先の住所
75: ' SENT_TEL = 発送先の電話番号
76: ' MEMO = 摘要
77: Dim objContext As ObjectContext
78: Dim objRec As ADODB.Recordset
79: Dim userName As String, NowDate As Date
80:
81: ' オブジェクトコンテキストの取得
82: Set objContext = GetObjectContext()
83:
84: ' エラーハンドラの設定
85: On Error GoTo ErrHandle
86:
87: ' ユーザー名とその時点の時刻を取得
88: userName = objContext.Security.GetOriginalCallerName()
89: NowDate = Now()
90:
91: ' 与えられた引数が正しいかどうかをチェック
92: Chk_SLIPID SlipID
93: Chk_DIVISION DIVISION
94: Chk_PERSON PERSON
95: Chk_DELIVERDATE DELIVERDATE
96: Chk_SENT_ADDR SENT_ADDR
97: Chk_SENT_TEL SENT_TEL
98: Chk_MEMO MEMO
99:
100: ' データベースと接続し,書き込み可能なレコードセットを取得
101: Set objRec = CreateObject("ADODB.Recordset")
102: objRec.Open "伝票追加情報", g_DBConnection, adOpenKeyset, _
adLockPessimistic, adCmdTable
103:
104: ' 新しいレコードを追加
105: objRec.AddNew
106:
107: ' レコードにデータを設定
108: objRec.Fields("SLIPID").Value = SlipID
109: objRec.Fields("DIVISION").Value = DIVISION
110: objRec.Fields("PERSON").Value = PERSON
111: objRec.Fields("DELIVERDATE").Value = DELIVERDATE
112: objRec.Fields("SENT_ADDR").Value = SENT_ADDR
113: objRec.Fields("SENT_TEL").Value = SENT_TEL
114: objRec.Fields("MEMO").Value = MEMO
115: objRec.Fields("MADEDATE").Value = NowDate
116: objRec.Fields("LASTDATE").Value = NowDate
117: objRec.Fields("MADEUSER").Value = userName
118: objRec.Fields("LASTUSER").Value = userName
119: objRec.Fields("DELETEDFLAG").Value = False
120:
121: ' データベースに反映
122: objRec.Update
123:
124: ' 追加した伝票追加情報のレコードIDを戻り値として設定
125: AddRecord = objRec.Fields("ID").Value
126:
127: ' データベースとの接続を閉じてレコードセットを解放
128: objRec.Close
129: Set objRec = Nothing
130:
131: ' トランザクションをコミット
132: objContext.SetComplete
133:
134: ' オブジェクトコンテキストの解放
135: Set objContext = Nothing
136:
137: Exit Function
138:
139: ErrHandle:
140: ' エラーハンドラ
141: objContext.SetAbort
142:
143: Set objContext = Nothing
144: Set objRec = Nothing
145:
146: ' エラーの再発行
147: Err.Raise Err.NUMBER, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
148: End Function