ADO Dis-connected recordset problem

[Minty]

Hi All,

I very rarely use ADO, but am playing with using a disconnected ADO recordset to populate a imitation "tree-view" sub-form (caused by a corporate switch to 64 bit Access, and 2016 version).

Currently the form works but relies on a temporary local table currently - which means if I want multiple instances of the form open I have to create multiple temp tables, so I thought "why not use a disconnected recordset" instead.

So after battling with it for most of the afternoon, I'm possibly coming to the conclusion that I can't do a couple of things.
a) Update a ADO recordset row with non ascii characters (I'm trying to change a ► at the start to a ● if there is no child item to indicate no expansion is possible) using

 .Fields("NodeCaption") = Replace(.Fields("NodeCaption"), ChrW(9658), ChrW(9679) & " ")

The full code of the bit I'm struggling with is;

Set rsTree = New ADODB.Recordset
        Set cn = CurrentProject.Connection
        With rsTree
            Set .ActiveConnection = cn
            .Source = sSql                      
            .LockType = adLockOptimistic
            .CursorType = adOpenKeyset
            .CursorLocation = adUseClient
            .Open
        End With
        Set cn = Nothing
        'qd.Execute dbFailOnError
        '        qd.Close
                
        'Mark records without children with a small black circle eg: Replace([NodeCaption],ChrW(9658),ChrW(9679) & " ")
        'Add the trailing space to get the items to line up
        'Set IsExpanded and Is Group to False
          
        With rsTree
            .MoveLast
            .MoveFirst
          '  Debug.Print .RecordCount
            While Not .EOF
                If .Fields("ChildrenCount") = 0 Then
                     Debug.Print "RS "; .Fields!NodeCaption
                    [COLOR="Red"].Fields("NodeCaption") = Replace(.Fields("NodeCaption"), ChrW(9658), ChrW(9679) & " ")[/COLOR]     'This line fails 
                    .Fields("IsExpanded") = 0
                    .Fields("IsGroup") = 0
                    .Update
                End If
                .MoveNext
            Wend
        End With

The error is:
Multiple-step operation generated errors .Check each status value.

If I can get past this niggling issue - I have made the assumption that I can add and delete rows from this recordset, before discarding it when the form is unloaded, am I correct?

I presume I can't achieve this with a DOA recordset, as it can't be disconnected. The only other route would be a Array, but that seems really over the top.
And I hate array's.

 

[MarkK]

What's not clear to me is if the Replace is failing or the assignment to the field. Can you split those up, just to debug them? Assign the result of the Replace() to a variable, then Debug.Print that variable to confirm that is working, then assign that variable's value to the value of the field.

Also, or maybe instead, reverse these lines...

   .Fields("NodeCaption") = Replace(.Fields("NodeCaption"), ChrW(9658), ChrW(9679) & " ")
   .Fields("IsExpanded") = 0

...and see what happens. Maybe the recordset is not allowing edits, and it is not even a function of the Replace(), or the ChrW().

Finally, I'm not sure that you have actually disconnected the recordset.

        Set cn = CurrentProject.Connection
        With rsTree
            Set .ActiveConnection = cn
            .Source = sSql                      
            .LockType = adLockOptimistic
            .CursorType = adOpenKeyset
            .CursorLocation = adUseClient
            .Open
        End With
        Set cn = Nothing [COLOR="Green"]'this does not disconnect the recordset.[/COLOR]
        Set rsTree.ActiveConnection = Nothing[COLOR="green"] 'this disconnects the recordset[/COLOR]

cn, in your code, is an independent variable. Setting it to nothing has no impact on the recordset. The recordset maintains it's own pointer to the connection, so you have to actually set the .ActiveConnection property of the recordset to nothing in order to disconnect it. I think.
hth
Mark

 

[Minty]

Thanks Markk
Having split things out, it's not the replace - I suspect I can't update the recordset as the source query wouldn't allow edits.

I'm going to double check, but that would make sense.

If only Access could had memory based temp tables like SQL, this would be a doddle in a stored procedure.

I'm probably going to have to go down the array route, but with unknown numbers of records, I think it will be too much like hard work.
Did I mention I hate arrays.

 

[static]

I think you need to create your own connection.

I just tested it on a read only query and only got error "Insufficient key column information for updating or refreshing." when doing the update...

Dim cn As New ADODB.Connection
With cn
	.ConnectionString = CurrentProject.Connection
	.CursorLocation = adUseClient
	.Open
End With

With New ADODB.Recordset
	.Open "select * from table1", cn, adOpenKeyset, adLockBatchOptimistic
	'.Open "select * from query1", cn, adOpenKeyset, adLockBatchOptimistic
	.ActiveConnection = Nothing

	If .EOF Then
		.Close
		Exit Sub
	End If
	
	For Each f In .Fields
		Debug.Print f.Name,
	Next
	
	Debug.Print
	
	.Fields(0) = ChrW(9679)
	
	Do Until .EOF
		For Each f In .Fields
			Debug.Print f.Value,
		Next
		Debug.Print
		.MoveNext
	Loop
	
	'reconnect to the database + update table
	'.ActiveConnection = cn
	'.UpdateBatch
	.Close
End With
cn.Close

 

[Galaxiom]

it's not the replace - I suspect I can't update the recordset as the source query wouldn't allow edits.

Did you understand what Mark posted? You have not disconnected the recordset.

Disconnected recordsets are very updateable even where the underlying query is definitely not updateable.

I use disconnected recordsets based on queries like the following to add a Boolean field for supporting a checkbox on forms. Dummytable has a single record with an ID that is not in maintable.

SELECT maintable.*, dummytable.checkfield
FROM maintable
LEFT OUTER JOIN dummytable
ON dummytable.ID <> sometable.ID

Despite there only being one record for checkfield, the disconnected recordset allows the field to be separately updated for each record on the form. Obviously it cannot be reconnected.

 

[arnelgp]

Its disconnected so you cant update it.
Create a new ado recordset and fill the data from ur table.
Incorpotate the repl while adding.
Use this recordset.

 

[Minty]

Did you understand what Mark posted? You have not disconnected the recordset.

Sorry I should have said that I modified the code to disconnect as per Mark's post.

Despite there only being one record for checkfield, the disconnected recordset allows the field to be separately updated for each record on the form. Obviously it cannot be reconnected.

This is essentially what I wanted to achieve. The "treeview" form is purely a view on the data, that I want to add and remove child records from the disconnected recordset based on form events.
So the rs load code is currently;

        Set rsTree = New ADODB.Recordset
        Set cn = CurrentProject.Connection
        With rsTree
            Set .ActiveConnection = cn
            .Source = sSql                      
            .LockType = adLockOptimistic
            .CursorType = adOpenKeyset
            .CursorLocation = adUseClient
            .Open
        End With
        Set cn = Nothing
        Set rsTree.ActiveConnection = Nothing

I altered the characters used to use standard Ascii codes, so that isn't the issue - the same error occurs in here on a different field;

Dim sNodeLine As String
        
        With rsTree
            .MoveLast
            .MoveFirst
          '  Debug.Print .RecordCount
            While Not .EOF
                If .Fields("ChildrenCount") = 0 Then
                    ' debug.Print "RS "; .Fields!NodeCaption
                    sNodeLine = Replace(.Fields!NodeCaption, Chr(62), Chr(149) & " ")
                    Debug.Print sNodeLine
           [COLOR="Red"]         .Fields!IsExpanded = 0[/COLOR]       ' Error now here
                    .Fields!NodeCaption = sNodeLine       
                    .Fields!IsGroup = 0
                    .Update
                End If
                .MoveNext
            Wend
        End With

 

[Galaxiom]

Don't know it it matters but I can see you have changed the syntax referring to fields.

Previously

 .Fields("fieldname")

Now

.Fields!fieldname

I always use

!fieldname

The bang is a Late Bound reference to the default member of an object.
I would not have expected this to be valid:

.Fields!fieldname

 

[Minty]

I have now tried both methods just in case.

fields!fieldname

And

!fieldname

both compile and work.
As is often the way I changed it just trying different things to get it working.

The form is based on this https://www.codeproject.com/Articles/597302/A-Tree-View-Control-Using-an-MS-Access-Table-and-F , it's a simple way of displaying a treeview type list without much difficulty.
I was trying to adapt it to use a recordset instead of a table, to allow me to use it more than once without creating and referencing a table per use.

 

[static]

You've still got cursorlocation set on the recordset.
As I said above, it should be on the connection. And since you can't change the project connection you need to create your own.

 

[Minty]

You've still got cursorlocation set on the recordset.
As I said above, it should be on the connection. And since you can't change the project connection you need to create your own.

@Static - sorry I missed your post. That makes sense , will try this and let you know the outcome.

 

[Minty]

@Static

I've tried every variation of this I can fathom without success.
I am unable to open another connection of any type without getting a
"The database has been placed in a state by user “Admin” on machine that prevents it from being opened or locked" Error
Which is weird as I'm the only user of this database and there are no tables being opened that are local.
The database is set to do no record locks and to open in shared mode.

I can get past that by using currentproject.connection but then seem unable to do anything to the data in the recordset.

I'm going to make a sample database and upload it so someone wiser than me can have a look.

Just to clarify the intention,
Load a made up recordset and use it as a form recordsource purely for display purposes.
Add and remove records from it and refresh the forms display.
Dispose of it on form close.
No update back to a table.

This is currently achieved using a local table.
This is fine for single use but if you want to use the same sub-form on other forms you have to have another table per form instance.

 

[MarkK]

Here's a test I just did...

Private Function GetDisconnectedRecordset(SQL As String) As ADODB.Recordset
    Dim rs As New ADODB.Recordset
    With rs
        .CursorLocation = adUseClient
        .Open SQL, CurrentProject.AccessConnection, , adLockOptimistic
        Set .ActiveConnection = Nothing
    End With
    Set GetDisconnectedRecordset = rs
End Function

Private Sub Test1038470129348()
    Const SQL As String = _
        "SELECT Journal.JournalID, Journal.Number, Post.AccountID, Post.Memo, Post.USAmount, Post.Amount " & _
        "FROM Journal INNER JOIN Post ON Journal.JournalID = Post.JournalID " & _
        "WHERE (((Journal.JournalID)=16758)); "
        
    Dim rs As ADODB.Recordset
    Set rs = GetDisconnectedRecordset(SQL)
    
    With rs
        Debug.Print "Orig: " & .Fields(0)
        .Fields(0) = -1
        .Update
        Debug.Print "Edit: " & .Fields(0)
        .Close
    End With
End Sub

This successfully opens a disconnected recordset based on joined tables, and edits the AutoNumber ID field of one of the tables. The output in the immediate pane is...

Orig: 16758
Edit: -1

Maybe this'll help solve what you are working on???
Mark

 

[Minty]

I think it's something to do with my set up / database.
Using your function open the recordset and just trying to update one value in it to I get the same issue;
"Multistep-operation generated errors. Check each status value"
I'm going to port this all back into my old 32-bit Access 2010 system and have another look. I'm beginning to suspect some other (not very obvious) cause...

I've not been over enamored with 64 bit Access 2016 on a brand new laptop (i5 16Gb Ram etc.).
I've had a lot of crashing and locking up with it, compared to my old system. (i7 8Gb Ram)

 

[static]

@Static

I've tried every variation of this I can fathom without success.
I am unable to open another connection of any type without getting a
"The database has been placed in a state by user “Admin” on machine that prevents it from being opened or locked" Error
Which is weird as I'm the only user of this database and there are no tables being opened that are local.

I think that's quite common for ADO if you've edited a database object. I got it myself when creating the example. Close the database and retry.
If that's going to an issue in a live environment I think you'll need to build the recordset and populate it yourself.


View attachment tree.accdb

 

[Minty]

@Static - Thanks for looking at this.

I can create a single view similar to yours, what I'm trying to do is load only the top level items into a recordset, cat, dog, horse, bird etc in your example, then if you select (click) on that item rebuild / insert into the recordset the child items for that selected item only, and then repeat again for a third level of child items if they are selected.

If you look at the attached (originally from here https://www.codeproject.com/Articles/597302/A-Tree-View-Control-Using-an-MS-Access-Table-and-F ) you'll see it done using a local table.

I've had to leave this alone as am very busy with another project - but will revisit it once things have calmed down.

 

[static]

NP.

If I try to open frmTreeView01 it locks Access up.

I did a quick edit on mine.

The logic for getting child nodes is in the class so that each node can load it's own children recursively. All I did was take the recursion out.
And because items are stored in collections, by deleting a parent you automatically remove its children...

Then you just create a rs based on the collection.

Class1

Public children As New Collection
Public strName As String
Public id As Long
Public depth As Integer

Public Sub GetChildren(parent As Long, rs As DAO.Recordset, dpth As Integer)
    depth = dpth
    
    Dim frs As DAO.Recordset
    Set frs = getrs(rs, parent)
    Dim c As Class1
    
    Do Until frs.EOF
        children.Add New Class1, "_" & frs(0)
        Set c = children("_" & frs(0))
        c.id = frs(0)
        c.strName = frs(1)
        c.depth = depth + 1
        'c.GetChildren frs(0), rs, depth + 1
        frs.MoveNext
    Loop
    frs.Close
End Sub

Private Function getrs(ByVal rs As DAO.Recordset, id As Long) As DAO.Recordset
    rs.Filter = "parent=" & id
    Set getrs = rs.OpenRecordset
    If getrs Is Nothing Then Stop
End Function

Form1

Dim tree As Class1

Private Sub MakeFormRS(cls As Class1, rs As ADODB.Recordset)
    Dim c As Class1
    For Each c In cls.children
        rs.AddNew
        rs(0).Value = c.id
        rs(1).Value = String((c.depth) * 6, " ") & c.strName
        rs.Update
        MakeFormRS c, rs
    Next
End Sub

Private Sub Form_Load()
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("select * from tree")
    Set tree = New Class1
    tree.strName = "root"
    tree.GetChildren 0, rs, 0
    rs.Close
    GenerateRecordset
End Sub

Private Sub GenerateRecordset()
    Dim adors As New ADODB.Recordset
    adors.Fields.Append "ID", adInteger
    adors.Fields.Append "Caption", adVarWChar, 255
    adors.LockType = adLockOptimistic
    adors.CursorType = adOpenStatic
    adors.Open
    MakeFormRS tree, adors
    adors.MoveFirst
    Set Me.Recordset = adors
    Text1.ControlSource = "caption"
    Text2.ControlSource = "id"
End Sub

Private Sub Text1_Click()
    Dim c As Class1
    Set c = FindNode(tree, Text2)
    If c Is Nothing Then
        MsgBox "not found"
        Exit Sub
    End If
    If c.children.Count <> 0 Then
        Set c.children = New Collection
    Else
        c.GetChildren Me("id"), CurrentDb.OpenRecordset("select * from tree"), c.depth
    End If
    GenerateRecordset
End Sub

Private Function FindNode(cls As Class1, fnd As Long) As Class1
    Dim c As Class1
    Dim found As Class1
    For Each c In cls.children
        If c.id = fnd Then
            Set FindNode = c
            Exit Function
        Else
            Set FindNode = FindNode(c, fnd)
            If Not FindNode Is Nothing Then Exit Function
        End If
    Next
End Function

 

[Minty]

Thank you, that makes perfect sense, I've not played around much with collections - Very neat.

When time permits I'll maneuver this method into the form I'm using. It should be very straight forwards.

Many thanks.