List 6-2　DataObj.CustomerコンポーネントのAddRecordメソッド

  1： ' データベース接続文字列
  2： Const g_DBConnection = _
   　    "Driver=SQL Server;Server=(local);UID=sa;Database=businesssampleDB;"
  3： 
  4： ' エラー処理関数群
  5： Private Sub Chk_CUSTOMERNAME(ByRef CUSTOMERNAME As Variant)
  6：     ' 顧客名が正しいかどうか調べる
  7：     If IsNull(CUSTOMERNAME) Then
  8：         Err.Raise Errorcode.Err_NAMETOOLONG, App.Title, _
   　                   "顧客名に値が設定されていません"
  9：     End If
 10：     If Len(CUSTOMERNAME) > 64 Then
 11：         Err.Raise Errorcode.Err_NAMETOOLONG, App.Title, _
   　                   "顧客名は64文字以内でなければなりません"
 12：     End If
 13： End Sub
 14： 
 15： Private Sub Chk_YOMIGANA(ByRef YOMIGANA As Variant)
 16：     ' よみがなが正しいかどうかを調べる
 17：     If Len(YOMIGANA) > 80 Then
 18：         Err.Raise Errorcode.Err_YOMIGANATOOLONG, App.Title, _
   　                   "よみがなは80文字以内でなければなりません"
 19：     End If
 20： End Sub
 21： 
 22： Private Sub Chk_ZIP(ByRef ZIP As Variant)
 23：     ' 郵便番号が正しいかどうかを調べる
 24：     If Len(ZIP) > 10 Then
 25：         Err.Raise Errorcode.Err_ZIPTOOLONG, App.Title, _
   　                   "郵便番号は10文字以内でなければなりません"
 26：     End If
 27： End Sub
 28： 
 29： Private Sub Chk_ADDRESS(ByRef ADDRESS As Variant)
 30：     ' 住所が正しいかどうかを調べる
 31：     If Len(ADDRESS) > 255 Then
 32：         Err.Raise Errorcode.Err_ADDRESSTOOLONG, App.Title, _
   　                   "住所は255文字以内でなければなりません"
 33：     End If
 34： End Sub
 35： 
 36： Private Sub Chk_TELEPHONE(ByRef TELEPHONE As Variant)
 37：     ' 電話番号が正しいかどうかを調べる
 38：     If Len(TELEPHONE) > 32 Then
 39：         Err.Raise Errorcode.Err_TELEPHONETOOLONG, App.Title, _
   　                   "電話番号は32文字以内でなければなりません"
 40：     End If
 41： End Sub
 42： 
 43： Private Sub Chk_FAX(ByRef FAX As Variant)
 44：     ' FAX番号が正しいかどうかを調べる
 45：     If Len(FAX) > 32 Then
 46：         Err.Raise Errorcode.Err_FAXTOOLONG, App.Title, _
  　                   "FAX番号は32文字以内でなければなりません"
 47：     End If
 48： End Sub
 49： 
 50： Private Sub Chk_MEMO(ByRef MEMO As Variant)
 51：     ' 摘要が正しいかどうかを調べる
 52：     If Len(MEMO) > 80 Then
 53：         Err.Raise Errorcode.Err_MEMOTOOLONG, App.Title, _
  　                   "摘要は80文字以内でなければなりません"
 54：     End If
 55： End Sub
 56： 
 57： ' データ処理をする関数
 58： Public Function AddRecord(ByVal CUSTOMERNAME As Variant, _
   　                           ByVal YOMIGANA As Variant, _
   　                           ByVal ZIP As Variant, _
   　                           ByVal ADDRESS As Variant, _
   　                           ByVal TELEPHONE As Variant, _
   　                           ByVal FAX As Variant, _
   　                           ByVal MEMO As Variant) As Long
 59：     ' 顧客情報テーブルに新しいレコードを加える
 60：     ' 【引数】
 61：     '   CUSTOMERNAME = 顧客名，YOMIGANA = 顧客名のよみがな
 62：     '   ZIP = 郵便番号, ADDRESS = 住所
 63：     '   TELEPHONE = 電話番号, FAX = FAX番号
 64：     '   MEMO = 摘要
 65：     ' 【戻り値】
 66：     '   登録した顧客の顧客番号（顧客情報テーブルのIDフィールドの値）
 67：     Dim objContext As ObjectContext
 68：     Dim objRec As ADODB.Recordset
 69：     Dim userName As String, NowDate As Date
 70：     
 71：     ' オブジェクトコンテキストの取得
 72：     Set objContext = GetObjectContext()
 73：     
 74：     ' エラーハンドラの設定
 75：     On Error GoTo ErrHandle
 76：     
 77：     ' ユーザー名と現在の時刻を取得
 78：     userName = objContext.Security.GetOriginalCallerName()
 79：     NowDate = Now()
 80：     
 81：     ' 与えられた引数が正しいかどうかをチェック
 82：     Chk_CUSTOMERNAME CUSTOMERNAME
 83：     Chk_YOMIGANA YOMIGANA
 84：     Chk_ZIP ZIP
 85：     Chk_ADDRESS ADDRESS
 86：     Chk_TELEPHONE TELEPHONE
 87：     Chk_FAX FAX
 88：     Chk_MEMO MEMO
 89：     
 90：     ' データベースと接続して，書き込み可能なレコードセットを得る
 91：     Set objRec = CreateObject("ADODB.Recordset")
 92：     objRec.Open "顧客情報", g_DBConnection, adOpenKeyset, _
   　                 adLockPessimistic, adCmdTable
 93：     
 94：     ' 新しいレコードを追加
 95：     objRec.AddNew
 96：     
 97：     ' レコードにデータを設定
 98：     objRec.Fields("NAME").Value = CUSTOMERNAME
 99：     objRec.Fields("YOMIGANA").Value = YOMIGANA
100：     objRec.Fields("ZIP").Value = ZIP
101：     objRec.Fields("ADDRESS").Value = ADDRESS
102：     objRec.Fields("TELEPHONE").Value = TELEPHONE
103：     objRec.Fields("FAX").Value = FAX
104：     objRec.Fields("MEMO").Value = MEMO
105：     objRec.Fields("MADEUSER").Value = userName
106：     objRec.Fields("MADEDATE").Value = NowDate
107：     objRec.Fields("LASTUSER").Value = userName
108：     objRec.Fields("LASTDATE").Value = NowDate
109：     objRec.Fields("DELETEDFLAG").Value = 0
110：     
111：     ' データベースに反映
112：     objRec.Update
113：     
114：     ' 作成した顧客情報の顧客番号を戻り値として設定する
115：     AddRecord = objRec.Fields("ID").Value
116：     
117：     ' データベースとの接続を閉じてレコードセットを解放
118：     objRec.Close
119：     Set objRec = Nothing
120：     
121：     ' コミットする
122：     objContext.SetComplete
123：     
124：     ' オブジェクトコンテキストの解放
125：     Set objContext = Nothing
126：     
127：     Exit Function
128： 
129： ErrHandle:
130：     ' エラーハンドラ
131：     objContext.SetAbort
132：     Set objContext = Nothing
133：     Set objRec = Nothing
134：     
135：     ' エラーの再発行
136：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
137： 
138： End Function