List 6-90 DataObj.SlipコンポーネントのAddRecordメソッド
1: Private Sub Chk_CustomerID(CustomerID As Variant)
2: ' 顧客番号が正しいかどうかを調べる
3: If IsNull(CustomerID) Then
4: Err.Raise Errorcode.Err_CUSTOMERID, App.Title, _
"顧客番号が設定されていません"
5: Else
6: If Not IsNumeric(CustomerID) Then
7: Err.Raise Errorcode.Err_CUSTOMERID, App.Title, _
"顧客番号が正しい数値でありません"
8: End If
9: End If
10: End Sub
11:
12: Private Sub Chk_ONEBILLFLAG(ONEBILLFLAG As Variant)
13: ' ONEBILLFLAGが正しいかどうかを調べる
14: If VarType(ONEBILLFLAG) <> vbBoolean Then
15: Err.Raise Errorcode.Err_ONEBILLFLAG, App.Title, _
"請求書作成設定が正しくありません"
16: End If
17: End Sub
18:
19: Public Function AddRecord(ByVal CustomerID As Variant, _
ByVal ONEBILLFLAG As Variant) As Long
20: ' 伝票情報テーブルに新しいレコードを加える
21: ' 【引数】
22: ' CustomerID = 対象となる顧客を示す顧客番号
23: ' ONEBILLFLAG = この伝票に対して1枚の請求書を作るならばTrue,
24: ' 別の伝票と合わせて月次の請求書を作るならばFalse
25: ' 【戻り値】
26: ' 追加した伝票を示す伝票番号(伝票のレコードID)
27: Dim objContext As ObjectContext
28: Dim objRec As ADODB.Recordset
29: Dim userName As String, NowDate As Date
30:
31: ' オブジェクトコンテキストの取得
32: Set objContext = GetObjectContext()
33:
34: ' エラーハンドラの設定
35: On Error GoTo ErrHandle
36:
37: ' ユーザー名と現在の時刻を取得
38: userName = objContext.Security.GetOriginalCallerName()
39: NowDate = Now()
40:
41: ' 与えられた引数が正しいかどうかをチェック
42: Chk_CustomerID CustomerID
43: Chk_ONEBILLFLAG ONEBILLFLAG
44:
45: ' データベースと接続して,書き込み可能なレコードセットを得る
46: Set objRec = CreateObject("ADODB.Recordset")
47: objRec.Open "伝票情報", g_DBConnection, adOpenKeyset, _
adLockPessimistic, adCmdTable
48:
49: ' 新しいレコードを追加
50: objRec.AddNew
51:
52: ' レコードにデータを設定
53: objRec.Fields("CUSTOMERID").Value = CustomerID
54: objRec.Fields("MADEDATE").Value = NowDate
55: objRec.Fields("SUBTOTAL").Value = 0
56: objRec.Fields("TAX").Value = 0
57: objRec.Fields("TOTAL").Value = 0
58: objRec.Fields("BILLID").Value = Null
59: objRec.Fields("BILLDATE").Value = Null
60: objRec.Fields("MADEBILLFLAG").Value = False
61: objRec.Fields("ONEBILLFLAG").Value = ONEBILLFLAG
62: objRec.Fields("REQ_CONSENTFLAG").Value = False
63: objRec.Fields("REQ_CONSENTDATE").Value = Null
64: objRec.Fields("REQ_CONSENTCOMMENT").Value = Null
65: objRec.Fields("CONSENTEDFLAG").Value = False
66: objRec.Fields("CONSENTEDDATE").Value = Null
67: objRec.Fields("CONSENTEDCOMMENT").Value = Null
68: objRec.Fields("REJECTEDFLAG").Value = False
69: objRec.Fields("REJECTEDDATE").Value = Null
70: objRec.Fields("REJECTEDCOMMENT").Value = Null
71: objRec.Fields("SENDFLAG").Value = False
72: objRec.Fields("SENDDATE").Value = Null
73: objRec.Fields("SENDCOMMENT").Value = Null
74: objRec.Fields("ACCOUNTINGFLAG").Value = False
75: objRec.Fields("ACCOUNTINGDATE").Value = Null
76: objRec.Fields("ACCOUNTINGCOMMENT").Value = Null
77: objRec.Fields("MADEUSER").Value = userName
78: objRec.Fields("REQ_CONSENTUSER").Value = Null
79: objRec.Fields("CONSENTEDUSER").Value = Null
80: objRec.Fields("REJECTEDUSER").Value = Null
81: objRec.Fields("SENDUSER").Value = Null
82: objRec.Fields("ACCOUNTINGUSER").Value = Null
83: objRec.Fields("LASTUSER").Value = userName
84: objRec.Fields("LASTDATE").Value = NowDate
85: objRec.Fields("DELETEDFLAG").Value = False
86:
87: ' データベースに反映
88: objRec.Update
89:
90: ' 追加した伝票情報のレコードIDを戻り値として設定
91: AddRecord = objRec.Fields("ID").Value
92:
93: ' データベースとの接続を閉じてレコードセットを解放
94: objRec.Close
95: Set objRec = Nothing
96:
97: ' トランザクションをコミット
98: objContext.SetComplete
99:
100: ' オブジェクトコンテキストの解放
101: Set objContext = Nothing
102:
103: Exit Function
104:
105: ErrHandle:
106: ' エラーハンドラ
107: objContext.SetAbort
108:
109: Set objContext = Nothing
110: Set objRec = Nothing
111:
112: ' エラーの再発行
113: Err.Raise Err.NUMBER, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
114: End Function