accessのＶＢＡでテーブル更新するには・・・？

質問

[input]フォームより「登録」ボタンを押すことで
[data]テーブルの[氏名][住所][電話番号][年齢][性別][コメント]フィールドを更新する動作をＶＢＡだけでさせたいです。
このボタンだけで新規登録と更新登録ように既存データの氏名と住所を参照して入力されたデータが既存なのかを確認するようにしたいです。
dim dbs as database
をつかってSQLを書き込んでいけばいけるような気がするのですが
どうもうまくいきません。

よろしくお願いします。

回答No.2

DVD-RW

Dim sqls as String

sqls = "DELETE FROM data WHERE 氏名 = '" & [氏名] & "' and 住所 = '" & [住所] & "';"
DoCmd.RunSQL sqls

sqls = "INSERT INTO data(氏名,住所,電話番号,以下省略) VALUES ("
sqls = sqls & " '" & [氏名] & "'"
sqls = sqls & ",'" & [住所] & "'"
sqls = sqls & ",'" & [電話番号] & "'"
sqls = sqls & ",'" & [以下省略] & "'"
sqls = sqls & ");"
DoCmd.RunSQL sqls

解説
まず、既存のデータの有無を期待せずに、とりあえず[氏名][住所]をキーにレコードを削除してしまいます。
そのあとに、レコードを追加しています。
詳しいことはAccessのリファレンスを参照してください。

回答No.1

noname#22222

DisplayRecord Me, "SELECT * FROM 得意先マスター"
UpdateRecord Me, "SELCT * FROM 得意先マスター WHERE ID=" & Me.ID

このように、僅か１行にて[得意先マスター]をフォーム[得意先マスター]に表示・更新することも可能です。

*****

いわゆる非連結フォームでフロントエンドを開発したいということでしょうか？
であれば、次の諸点についての方策・作法を確立されたがいいかも知れません。

１、主キーをどのように管理するのか？
２、テーブルのデータのフォームへの表示方法。
３、フォームデータに基づきテーブルを更新する方法。

さて、フォームを作成する都度に、これらを実行するコードを書くのは難儀です。
ですから、この３つの手続きは関数化するのがお勧めです。

まず、テーブルの各列に対応するテキストボックスの命名規則を決めればいいです。
例えば、'field_列名' など。
そうすれば、 前述の DisplayRecord()、UpdateRecord() も割りと簡潔なものになります。
なお、[採番テーブル]云々の１についての回答は割愛します。

' -----------------------------------------------------------------------------------------
'　フォームに読み込んだ列情報を表示します。
'
'　【要件】 ファームのフィールド名が、＜"field_" ＋ 列名＞であること。
' -----------------------------------------------------------------------------------------
Public Function DisplayRecord(ByVal frm As Form, _
　　　　　　　　　　　　　　　ByVal strQuerySQL As String) As Boolean

On Error GoTo Err_DisplayRecord
　　Dim isOK As Boolean
　　Dim I　　As Integer
　　Dim N　　As Integer
　　Dim rst　As ADODB.Recordset
　　Dim fld　As ADODB.Field

　　isOK = True
　　Set rst = New ADODB.Recordset
　　rst.Open strQuerySQL, _
　　　　　　 CurrentProject.Connection, _
　　　　　　 adOpenStatic, _
　　　　　　 adLockReadOnly
　　If Not rst.BOF Then
　　　　' =================
　　　　'　Begin With: frm
　　　　' -----------------
　　　　With frm
　　　　　　N = .Controls.Count - 1
　　　　　　For Each fld In rst.Fields
　　　　　　　　For I = 0 To N
　　　　　　　　　　If Mid$(.Controls(I).Name, 7) = fld.Name Then
　　　　　　　　　　　　.Controls(I).Value = fld.Value
　　　　　　　　　　　　Exit For
　　　　　　　　　　End If
　　　　　　　　Next I
　　　　　　Next fld
　　　　End With
　　　　' ---------------
　　　　'　End With: frm
　　　　' ===============
　　Else
　　　　MsgBox " フォームに表示する情報はありません。(DisplayRecord)", vbInformation, " お知らせ"
　　End If
Exit_DisplayRecord:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DisplayRecord = isOK
　　Exit Function
Err_DisplayRecord:
　　isOK = False
　　MsgBox "実行時エラーが発生しました。(DisplayRecord)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DisplayRecord
End Function

Public Function UpdateRecord(ByVal frm As Form, _
　　　　　　　　　　　　　　 ByVal strSQL As String, _
　　　　　　　　　　　　　　 Optional Echo As Boolean = False) As Boolean
On Error GoTo Err_UpdateRecord
　　Dim isOK　　As Boolean
　　Dim I　　　 As Integer
　　Dim N　　　 As Integer
　　Dim fldName As String
　　Dim cnn　　 As ADODB.Connection
　　Dim rst　　 As ADODB.Recordset
　　Dim fld　　 As ADODB.Field

　　isOK = True
　　Set cnn = CurrentProject.Connection
　　' =================
　　'　Begin With: cnn
　　' -----------------
　　With cnn
　　　　.Errors.Clear
　　　　.BeginTrans

　　　　Set rst = New ADODB.Recordset
　　　　rst.Open strSQL, _
　　　　　　　　 cnn, _
　　　　　　　　 adOpenStatic, _
　　　　　　　　 adLockOptimistic
　　　　' =================
　　　　'　Begin With: rst
　　　　' -----------------
　　　　With rst
　　　　　　If Not .BOF Then
　　　　　　　　N = frm.Controls.Count - 1
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　For I = 0 To N
　　　　　　　　　　　　fldName = frm.Controls(I).Name
　　　　　　　　　　　　If Left$(fldName, 6) = "field_" Then
　　　　　　　　　　　　　　If Mid$(fldName, 7) = fld.Name Then
　　　　　　　　　　　　　　　　fld.Value = frm.Controls(I).Value
　　　　　　　　　　　　　　　　Exit For
　　　　　　　　　　　　　　End If
　　　　　　　　　　　　End If
　　　　　　　　　　Next I
　　　　　　　　Next fld
　　　　　　　　.Update
　　　　　　End If
　　　　End With
　　　　' ---------------
　　　　'　End With: rst
　　　　' ===============
　　　　.CommitTrans
　　End With
　　' ---------------
　　'　End With: cnn
　　' ===============
　　If Echo Then
　　　　MsgBox " １件のレコードを更新または保存しました。", vbInformation, " お知らせ"
　　End If
Exit_UpdateRecord:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　UpdateRecord = isOK
　　Exit Function
Err_UpdateRecord:
　　isOK = False
　　If cnn.Errors.Count > 0 Then
　　　　ErrMessage cnn.Errors(0), strSQL
　　　　cnn.RollbackTrans
　　Else
　　　　MsgBox "プログラムエラーが発生しました。(UpdateRecord)" & Chr$(13) & Chr$(13) & _
　　　　　　　 "・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　　 "・SQL Text=" & strSQL, _
　　　　　　　 vbExclamation, " 関数エラーメッセージ"
　　End If
　　Resume Exit_UpdateRecord
End Function

Public Sub ErrMessage(ByVal CnnErrors As ADODB.Error, ByVal strSQL As String)
　　 MsgBox "ADOエラーが発生しましたので処理をキャンセルします。" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & CnnErrors.Description & Chr$(13) & _
　　　　　　"・Err.Number=" & CnnErrors.Number & Chr$(13) & _
　　　　　　"・SQL State=" & CnnErrors.SQLState & Chr$(13) & _
　　　　　　"・SQL Text=" & strSQL, _
　　　　　　vbExclamation, " ADO関数エラーメッセージ"
End Sub