List 6-22 DataObj.CustomerコンポーネントのUpdateRecord_BILLDAYメソッドを変更したもの(変更箇所は赤色で示した)
1: Public Sub UpdateRecord_BILLDAY(ByVal CUSTOMERID As Long, _
ByVal BILLDAY As Variant)
2: ' 顧客情報テーブル内の指定された顧客番号の締め日を変更する
3: ' 【引数】
4: ' CUSTOMERID = 変更したい顧客を特定する顧客番号を指定する
5: ' BILLDAY = 設定する顧客の締め日を指定する
6: ' 【戻り値】
7: ' なし
8: Dim objContext As ObjectContext
9: Dim objRec As ADODB.Recordset
10: Dim userName As String, NowDate As Date
11: Dim objHistory As DataObj.History
12:
13: ' オブジェクトコンテキストの取得
14: Set objContext = GetObjectContext()
15:
16: ' エラーハンドラの設定
17: On Error GoTo ErrHandle
18:
19: ' DataObj.Historyコンポーネントの実体化
20: Set objHistory = CreateObject("DataObj.History")
21:
22: ' ユーザー名と現在の時刻を取得
23: userName = objContext.Security.GetOriginalCallerName()
24: NowDate = Now()
25:
26: ' 与えられた引数が正しいかどうかをチェック
27: If (BILLDAY < 1) Or (BILLDAY > 31) Then
28: ' 締め日が不正
29: Err.Raise Errorcode.Err_BILLDAY, App.Title, _
"締め日は1〜31の範囲になければなりません"
30: End If
31:
32: ' データベースと接続して,指定された顧客の顧客情報を更新する
33: Set objRec = CreateObject("ADODB.Recordset")
34: objRec.Open "SELECT * FROM 顧客情報 WHERE ID=" & CUSTOMERID, _
g_DBConnection, adOpenKeyset, adLockPessimistic, adCmdText
35:
36: If objRec.EOF Then
37: Err.Raise Errorcode.Err_NotFound, App.Title, _
"指定された顧客番号をもつ顧客が見つかりません"
38: End If
39:
40: ' レコードの値を更新
41: If objRec.Fields("BILLDAY").Value <> BILLDAY _
Or (IsNull(objRec.Fields("BILLDAY").Value) Xor IsNull(BILLDAY)) Then
42: objHistory.AddHistory "顧客情報", "BILLDAY", CUSTOMERID, objRec.Fields("BILLDAY").Value, BILLDAY
43: objRec.Fields("BILLDAY").Value = BILLDAY
44: End If
45: objRec.Fields("LASTUSER").Value = userName
46: objRec.Fields("LASTDATE").Value = NowDate
47: objRec.Update
48:
49: ' データベースとの接続を閉じてレコードセットを解放
50: objRec.Close
51: Set objRec = Nothing
52:
53: ' DataObj.Historyオブジェクトを解放する
54: Set objHistory = Nothing
55:
56: ' コミットする
57: objContext.SetComplete
58:
59: ' オブジェクトコンテキストの解放
60: Set objContext = Nothing
61:
62: Exit Sub
63:
64: ErrHandle:
65: ' エラーハンドラ
66: objContext.SetAbort
67: Set objContext = Nothing
68: Set objRec = Nothing
69: Set objHistory = Nothing
70:
71: ' エラーの再発行
72: Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
73: End Sub