vba - 访问表单链接到断开连接的 ADODB.Recordset : save changes

Question

我正在尝试设置一个表单以使用断开连接的 ADODB.Recordset 作为其源。
我遇到的问题是，关闭表单并对提示回复"is"后，更改不会保存到原始 Access 表中。我错过了什么？

注意:请不要告诉我方法没用，它只是一个带有本地表的POC，我打算稍后尝试使用更“远”的记录集。

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset

Private Sub Form_Load()
    Set conn = New ADODB.Connection
    conn.Open CurrentProject.Connection

    Set rs = New ADODB.Recordset
    With rs
        rs.CursorLocation = adUseClient
        rs.Open "select * from amsPor", conn, adOpenStatic, adLockBatchOptimistic
        Set rs.ActiveConnection = Nothing
    End With
    Set Me.Recordset = rs
    conn.Close
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Select Case MsgBox("Save changes ?", vbQuestion + vbYesNoCancel)
    Case vbNo
        'do nothing
    Case vbYes
        conn.Open CurrentProject.Connection
        rs.ActiveConnection = conn
        rs.UpdateBatch
        rs.Close
        conn.Close
        Set conn = Nothing
    Case vbCancel
        Cancel = True
    End Select
End Sub

重现步骤:

拿一张有主键的小表

用它生成一个自动表单

保存表格。

将以上代码添加到表单中，替换select中的表名条款。

清空Record Source形式的属性。

保存并关闭表单。

您可以打开表单并对数据进行更改。关闭后，系统将提示您保存更改。

编辑 : 我想知道问题是否出在 CurrentProject.Connection ?
在调试窗口中，我输入 ? CurrentProject.Connection并得到以下信息:

Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=\\xxxxxx\yyyy$\Documents\AMS.accdb;Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database=C:\Users\G828992\AppData\Roaming\Microsoft\Access\System.mdw;Jet OLEDB:Registry Path=Software\Microsoft\Office\14.0\Access\Access Connectivity Engine;Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=True;Jet OLEDB:Bypass UserInfo Validation=False

Answer 1

我来到这里寻找与您相同的答案，经过大量的谷歌搜索和反复试验，我终于能够准确地执行您正在尝试做的事情。我知道这是一篇旧帖子，但我没有看到任何实际提供的答案可以让您尝试做的事情的答案。我将使用您的示例并尝试应用我必须更改和添加的内容以使其正常工作。

Dim rs As ADODB.Recordset
Dim conn As ADODB.Connection

Private Sub Form_Load()
    If CurrentProject.Connection.State = adStateOpen Then CurrentProject.Connection.Close

    Set conn = New ADODB.Connection
    conn.Open CurrentProject.Connection.ConnectionString

    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Open "select * from amsPor", conn, adOpenForwardOnly, adLockBatchOptimistic

    If Not rs Is Nothing Then
        If Not rs.ActiveConnection Is Nothing Then Set rs.ActiveConnection = Nothing
        If Not (rs.eof And rs.BOF) Then
            Set Me.Recordset = rs
        End If

        If conn.State = adStateOpen Then
            conn.Close
        End If
    End If

    Call AddNewRecord(Me.Recordset)
End Sub


Private Sub AddNewRecord(ByRef rs As ADODB.Recordset)
    On Error Resume Next 

    If Not rs Is Nothing Then
        If rs.Supports(adAddNew) Then
            rs.AddNew
            rs.Fields("FirstName").Value = "John"
            rs.Fields("LastName").Value = "Doe"

            If rs.Supports(adUpdate) Then rs.Update
        End If
    End If

    If Err.Number <> 0 Then
        Debug.Print "AddNewRecord Err Msg: " & Err.Description
        Err.Clear
    End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Select Case MsgBox("Save changes ?", vbQuestion + vbYesNoCancel)
    Case vbYes
        Call UpdateDbWithRS(Me.Recordset)
    Case vbCancel
        Cancel = True
    Case Else
        ' Nothing.
    End Select
End Sub


Private Sub UpdateDbWithRS(ByRef rs As ADODB.Recordset)
    If Not rs Is Nothing Then
        If CurrentProject.Connection.State = adStateOpen Then CurrentProject.Connection.Close

        Set conn = New ADODB.Connection
        conn.Open CurrentProject.Connection.ConnectionString
        rs.ActiveConnection = conn

        If rs.Supports(adUpdateBatch) Then
            rs.UpdateBatch

            If Not conn Is Nothing Then
                If conn.State = adStateOpen Then conn.Close
                Set conn = Nothing
            End If
            If Not rs Is Nothing Then
                If rs.State = adStateOpen Then rs.Close
                Set rs = Nothing
            End If
        End If
    End If
End Sub

使用上面的代码，我可以 添加 记录 到我的 记录集 并验证它没有出现在我的数据库表中。然后当我执行 UpdateDbWithRS 记录 我已添加到 记录集 ，以前，现在被推送到我的数据库表。

我对您的代码所做的最大更改是更改 conn.Open CurrentProject.Connection至 conn.Open CurrentProject.Connection.ConnectionString , 加入代码 If CurrentProject.Connection.State = adStateOpen Then CurrentProject.Connection.Close修复我收到的有关已打开连接的错误。然后我做的最后一个最大的改变是更换了你的 光标类型 的 adOpenStatic至 adOpenForwardOnly .我不确定是否真的需要最后一次更改，但我根据在此 Microsoft Support Site 上找到的断开连接的 RecordSet 示例使用了它。 .