2009/06/15

非連結フォームによる更新削除

[前提条件]
テーブルのフィールド名とフォームのフィールド名が一致
Option Compare Database
Option Explicit
Const cnStr = "接続文字列"

Private Sub Form_BeforeUpdate(Cancel As Integer)'更新確認
If MsgBox("更新しますか?", vbOKCancel) = vbCancel Then Cancel = True: Me.Undo
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
'データの競合ポップアップ抑制
If DataErr = 7787 Then
MsgBox "データが競合しています。"
Response = acDataErrContinue
End If
End Sub

Private Sub Form_Open(Cancel As Integer)
Call rsreSet
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
Set cn = Me.Recordset.ActiveConnection
Set rs = Me.Recordset
rs.Close
cn.Close
Set cn = Nothing: Set rs = Nothing
End Sub

Private Sub rsreSet()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
cn.Open cnStr
rs.CursorLocation = adUseClient
rs.Open "SQL文字列", cn, adOpenKeyset, adLockOptimistic
Set Me.Recordset = rs'フィールド名が一致している
Set cn = Nothing
Set rs = Nothing
End Sub

Private Sub コマンド15_Click()'次へ
On Error Resume Next
DoCmd.RunCommand acCmdRecordsGoToNext
End Sub

Private Sub コマンド16_Click()'前へ
On Error Resume Next
DoCmd.RunCommand acCmdRecordsGoToPrevious
End Sub

Private Sub コマンド17_Click()'移動せず更新
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
End Sub

Private Sub コマンド22_Click()'削除
On Error Resume Next
DoCmd.RunCommand acCmdDeleteRecord
End Sub

Private Sub コマンド23_Click()'recordset更新
rsreSet
End Sub

0 件のコメント: