List 6-144 DataObj.SlipコンポーネントのSet_REJECTEDFLAGメソッド
1: Public Sub Set_REJECTEDFLAG(ByVal SlipID As Long, _
ByVal flag As Boolean, _
ByVal Comment As Variant)
2: ' 指定された伝票のREJECTEDFLAGフィールドの値を変更する
3: ' 【引数】
4: ' SlipID = 変更したい伝票の伝票番号
5: ' flag = 変更後のREJECTEDFLAGフィールドの値
6: ' Comment = 変更時のコメント(flagがTrueのときのみ有効)
7: ' 【戻り値】
8: ' なし
9: Dim objContext As ObjectContext
10: Dim objRec As ADODB.Recordset
11: Dim userName As Variant, NowDate As Variant
12: Dim objHistory As DataObj.History
13:
14: ' オブジェクトコンテキストの取得
15: Set objContext = GetObjectContext()
16:
17: ' エラーハンドラの設定
18: On Error GoTo ErrHandle
19:
20: ' DataObj.Historyコンポーネントの実体化
21: Set objHistory = CreateObject("DataObj.History")
22:
23: ' ユーザー名とその時点の時刻を取得
24: userName = objContext.Security.GetOriginalCallerName()
25: NowDate = Now()
26:
27: ' 与えられた引数が正しいかどうかをチェック
28: Chk_Comment Comment
29:
30: ' データベースと接続して,指定された伝票の伝票情報を更新
31: Set objRec = CreateObject("ADODB.Recordset")
32: objRec.Open "SELECT * FROM 伝票情報 WHERE ID=" & SlipID, _
g_DBConnection, adOpenKeyset, adLockPessimistic, adCmdText
33:
34: If objRec.EOF Then
35: Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
"指定された伝票番号を持つ伝票が見つかりません"
36: End If
37:
38: ' レコードの値を更新
39: objRec.Fields("LASTUSER").Value = userName
40: objRec.Fields("LASTDATE").Value = NowDate
41:
42: If objRec.Fields("REJECTEDFLAG").Value <> flag Then
43: objHistory.AddHistory "伝票情報", "REJECTEDFLAG", SlipID, _
objRec.Fields("REJECTEDFLAG").Value, flag
44: objRec.Fields("REJECTEDFLAG").Value = flag
45: If flag = True Then
46: objHistory.AddHistory "伝票情報", "REJECTEDUSER", SlipID, _
objRec.Fields("REJECTEDUSER").Value, userName
47: objRec.Fields("REJECTEDUSER").Value = userName
48: objHistory.AddHistory "伝票情報", "REJECTEDDATE", SlipID, _
objRec.Fields("REJECTEDDATE").Value, NowDate
49: objRec.Fields("REJECTEDDATE").Value = NowDate
50: objHistory.AddHistory "伝票情報", "REJECTEDCOMMENT", SlipID, _
objRec.Fields("REJECTEDCOMMENT").Value, Comment
51: objRec.Fields("REJECTEDCOMMENT").Value = Comment
52: End If
53: End If
54:
55: objRec.Update
56:
57: ' データベースとの接続を閉じてレコードセットを解放
58: objRec.Close
59: Set objRec = Nothing
60:
61: ' DataObj.Historyオブジェクトの解放
62: Set objHistory = Nothing
63:
64: ' トランザクションのコミット
65: objContext.SetComplete
66:
67: ' オブジェクトコンテキストの解放
68: Set objContext = Nothing
69:
70: Exit Sub
71:
72: ErrHandle:
73: ' エラーハンドラ
74: objContext.SetAbort
75:
76: Set objContext = Nothing
77: Set objRec = Nothing
78: Set objHistory = Nothing
79:
80: ' エラーの再発行
81: Err.Raise Err.NUMBER, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
82: End Sub