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