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

多少制限があるものの一応動作する。
コマンドでのレコード移動時にrs.Updateしていないが、
フォームが編集モードにある場合での移動は更新されている。
データ競合の場合は、rs.Resyncで最新状態を取得
Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
rsSet
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection

Set rs = Me.Recordset
Set cn = Me.Recordset.ActiveConnection
rs.Close: cn.Close
Set rs = Nothing: Set cn = Nothing
End Sub

Private Sub コマンド0_Click() '閉じる
DoCmd.SetWarnings False'クリップボードに保存するか？とか聞いてくるので付けてみた
DoCmd.Close
DoCmd.SetWarnings True
End Sub

Private Sub rsSet()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim selectSQL As String

selectSQL = "SQLString"
cn.Open = "ConnectionString
rs.CursorLocation = adUseClient
rs.Open selectSQL, cn, adOpenKeyset, adLockOptimistic

Set Me.Recordset = rs
'コントロールのControlSourceは、プロパティで指定済み

Set rs = Nothing: Set cn = Nothing
End Sub

Private Sub コマンド20_Click() '前へ
On Error GoTo err_hnd
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
If Not Me.CurrentRecord = 1 Then
　rs.MovePrevious
Else
　rs.MoveLast
End If
Set rs = Nothing
Exit Sub
err_hnd:
rsResync
End Sub

Private Sub コマンド21_Click() '次へ
On Error GoTo err_hnd
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
If Me.CurrentRecord = Me.Recordset.RecordCount Then
　rs.MoveFirst
Else
　rs.MoveNext
End If
Set rs = Nothing
Exit Sub
err_hnd:
rsResync
End Sub

Private Sub コマンド22_Click() '保存
On Error GoTo err_hnd
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
rs.Update
Me.Refresh
Set rs = Nothing
Exit Sub
err_hnd:
rsResync
End Sub

Private Sub rsResync()
On Error Resume Next
Dim rs As New ADODB.Recordset
Set rs = Me.Recordset
Me.Undo
rs.Resync
Me.Refresh
End Sub