List 6-17 DataObj.UpdateRecordメソッド
  1: Public Sub UpdateRecord(ByVal CUSTOMERID As Long, _
                             ByVal NAME 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)
  2:     ' 顧客情報テーブル内の指定された顧客番号の顧客情報を変更する
  3:     ' 【引数】
  4:     '   CUSTOMERID = 変更したい顧客を特定する顧客番号を指定する
  5:     '   NAME = 設定する顧客名を指定する
  6:     '   YOMIGANA = 設定する顧客のよみがなを指定する
  7:     '   ZIP = 設定する顧客の郵便番号を指定する
  8:     '   ADDRESS = 設定する顧客の住所を指定する
  9:     '   TELEPHONE = 設定する顧客の電話番号を指定する
 10:     '   FAX = 設定する顧客のFAX番号を指定する
 11:     '   MEMO = 設定する顧客の摘要を設定する
 12:     ' 【戻り値】
 13:     '   なし
 14:     Dim objContext As ObjectContext
 15:     Dim objRec As ADODB.Recordset
 16:     Dim userName As String, NowDate As Date
 17:     
 18:     ' オブジェクトコンテキストの取得
 19:     Set objContext = GetObjectContext()
 20:     
 21:     ' エラーハンドラの設定
 22:     On Error GoTo ErrHandle
 23:     
 24:     ' ユーザー名と現在の時刻を取得
 25:     userName = objContext.Security.GetOriginalCallerName()
 26:     NowDate = Now()
 27:     
 28:     ' 与えられた引数が正しいかどうかをチェック
 29:     Chk_CUSTOMERNAME NAME
 30:     Chk_YOMIGANA YOMIGANA
 31:     Chk_ZIP ZIP
 32:     Chk_ADDRESS ADDRESS
 33:     Chk_TELEPHONE TELEPHONE
 34:     Chk_FAX FAX
 35:     Chk_MEMO MEMO
 36:     
 37:     ' データベースと接続して,指定された顧客の顧客情報を更新する
 38:     Set objRec = CreateObject("ADODB.Recordset")
 39:     objRec.Open "SELECT * FROM 顧客情報 WHERE ID=" & CUSTOMERID, _
                      g_DBConnection, adOpenKeyset, _
                      adLockPessimistic, adCmdText
 40:                 
 41:     If objRec.EOF Then
 42:         Err.Raise Errorcode.Err_NotFound, App.Title, _
                       "指定された顧客番号をもつ顧客が見つかりません"
 43:     End If
 44:     
 45:     ' レコードの値を更新
 46:     objRec.Fields("NAME").Value = NAME
 47:     objRec.Fields("YOMIGANA").Value = YOMIGANA
 48:     objRec.Fields("ZIP").Value = ZIP
 49:     objRec.Fields("ADDRESS").Value = ADDRESS
 50:     objRec.Fields("TELEPHONE").Value = TELEPHONE
 51:     objRec.Fields("FAX").Value = FAX
 52:     objRec.Fields("MEMO").Value = MEMO
 53:     objRec.Fields("LASTUSER").Value = userName
 54:     objRec.Fields("LASTDATE").Value = NowDate
 55:     objRec.Update
 56:     
 57:     ' データベースとの接続を閉じてレコードセットを解放
 58:     objRec.Close
 59:     Set objRec = Nothing
 60:     
 61:     ' コミットする
 62:     objContext.SetComplete
 63:     
 64:     ' オブジェクトコンテキストの解放
 65:     Set objContext = Nothing
 66:     
 67:     Exit Sub
 68:     
 69: ErrHandle:
 70:     ' エラーハンドラ
 71:     objContext.SetAbort
 72:     Set objContext = Nothing
 73:     Set objRec = Nothing
 74:     
 75:     ' エラーの再発行
 76:     Err.Raise Err.Number, Err.Source, Err.Description, _
                   Err.HelpFile, Err.HelpContext
 77: End Sub