Access form linked to disconnected ADODB.Recordset

问题:

I am trying to set up a form to use a disconnected ADODB.Recordset as its source.
The issue I have is that changes are not saved into the original Access table upon closing the form and replying "Yes" to the prompt. What am I missing ?

Note: Please don't tell me the method is useless, it's just a POC with a local table, I plan to try later with a more "distant" recordset.

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

---

Steps to Reproduce:

• Take a small table which has a primary key
• Generate an automatic form with it
• Save the form.
• Add the above code to the form, replacing the table name in the select clause.
• Empty the Record Source property of the form.
• Save and Close the form.
• You can open the form and make changes to the data. Upon close, you will be prompted for saving your changes.

---

EDIT: I wonder if the issue might be in the CurrentProject.Connection ?
In the debug window, I typed ? CurrentProject.Connection and got the following:

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

回答1:

I came here looking for the same answer as you and after tons of googling and trial and error I finally was able to perform exactly what you are attempting to do. I understand this is an old post but I did not see any answers that actually provided an answer that would allow what you are attempting to do work. I will use your example and try and apply what I had to change and add to get it to work properly.

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

With the code above I was able to Add a Record to my Recordset and verify it did not show up in my database table. Then when I performed the UpdateDbWithRS the Record that I had added to the Recordset, previously, was now pushed to my database table.

The biggest changes I had to do with your code was changing conn.Open CurrentProject.Connection to conn.Open CurrentProject.Connection.ConnectionString, adding in the code If CurrentProject.Connection.State = adStateOpen Then CurrentProject.Connection.Close to fix the error I was receiving about the connection already being opened. Then the final biggest change I made was replacing your CursorType of adOpenStatic to adOpenForwardOnly. I am not sure if that last change is truly required but I used it based on a disconnected RecordSet example I found on this Microsoft Support Site.

回答2:

When you use a disconnected recordset, you do not get the benefit of automatically updating changes to the tables. You need to actually run SQL Update and Insert Statements to save your data.

回答3:

First of all, your code look perfect and should works as well, but...

Solution 1

As per my experience i'd suggest to forget about such of functionality. Several years ago i struggled with the same problem. I did not found any solution, but i'm almost sure that the access database used in multiuser environment could not be updated, because Jet/ACE engine does not allow to update static recordset when other user had made changes in a meanwhile (changes are rejected).

I resolved this issue by using "temporary table" binded with form:

DELETE * FROM ~TableName;
INSERT INTO ~TableName SELECT * FROM TableName;

User can edit records till Form is opened. On Form_Unload event i run query like this:

UPDATE t1 SET Field1 = t2.Field1,
Field1 = t2.Field2 ... and so on
FROM TableName As t1 INNER JOIN ~TableName AS t2 ON t1.Key = t2.Key

Note, that insertion and deletion of records (if its allowed) should be handled separately.

Solution2

Use dynamic cursor and does not disconnect recordset from database ;) Catch changes by using Form.Dirty property.

回答4:

None of your code has anything to do with DISCONNECTED RECORDSETS. Your recordsets are connected. A disconnected recordset can be saved to file as xml or binary. There is no underlying database.

Note we make the disconnected recordset.

Sub Randomise
    Randomize 
    Set rs = CreateObject("ADODB.Recordset")
    With rs
        .Fields.Append "RandomNumber", 4 

        .Fields.Append "Txt", 201, 5000 
        .Open
        Do Until Inp.AtEndOfStream
            .AddNew
            .Fields("RandomNumber").value = Rnd() * 10000
            .Fields("Txt").value = Inp.readline
            .UpDate
        Loop
        .Sort = "RandomNumber"
        Do While not .EOF
            Outp.writeline .Fields("Txt").Value

            .MoveNext
        Loop
    End With
End Sub

Here are the states

ConnectionState

The ConnectionState enumeration is used to identify the state of a connector space object. The CSEntry.ConnectionState property contains one of the values of this enumeration.

Connected

The connector space object is connected to a metaverse object.

ExplicitlyConnected

The connector space object is connected explicitly by a member of the MIISAdmins or MIISOperators group to a metaverse object by the account joiner.

Disconnected

The connector space object is not connected to an metaverse object but may be a candidate for connection to a metaverse object in the future.

DisconnectedByFilter

The connector space object was disconnected by the connector filter rules.

Explicitly Disconnected The connector space object is not connected to a metaverse object and will not be a candidate for connection to a metaverse object in the future. Placeholder The connector space object exists implicitly in the connected directory, but has not been imported.