Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access VBA
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
Old July 3rd, 2004, 03:19 AM
Registered User
Join Date: Jul 2004
Posts: 2
Thanks: 0
Thanked 0 Times in 0 Posts
Default Argent Help Needed Shaped Recordset Problem

Hi to All Ado Shape Experts.
i had maintain a 1 to many relation ship in a single table
which has structre like

sintHeadid cHeadName sintParentId
0 MainHeads 0
1 Assets 1
2 currents Assets 1
3 cash 2
4 Bank 2

are u getting my points na .this is a chart of account that i maintain for an accounting firm .
now i want to open a SHAPED Recordset which can bring records

in the order like

from the above mention table
will u [please help me out
Old July 3rd, 2004, 08:45 PM
Friend of Wrox
Join Date: Jun 2003
Posts: 1,093
Thanks: 1
Thanked 12 Times in 11 Posts

Hi shery,

You'll need to build a nested (compound) relation hierarchy for the number of levels of relational data you need to map to the desired hierarchical data. The problem with using the SHAPE command, as opposed to say recursion, is that you need to know in advance the max number of levels you'll need to drill down to, then hardcode those levels in your SHAPE command script.

Here's my test table structure. The table is self-referencing:

Table: tblNodes
Join: [NodeID] <-> [ParentNodeID]

Field: NodeID
Type: Integer

Field: ParentNodeID
Type: Integer

Field: NodeName
Type: String

And here's my relational test data:

1; 0; Node1
2; 1; Node1.1
3; 2; Node1.1.1
4; 3; Node1.1.1.1
5; 0; Node2
6; 5; Node2.1
7; 6; Node2.1.1
8; 5; Node2.2

Finally, here's my hierarchical data generated by the module below:


I drilled down 4 levels since thats what your example is showing.

===Code=========================================== ====================

Option Compare Database

Sub Test()

    On Error GoTo Err_Test

    Dim cnn As ADODB.Connection

    ' Declare hierarchical recordset objects

    ' Level 1 nodes
    Dim rstLevel1 As ADODB.Recordset
    ' Level 2 nodes
    Dim rstLevel2 As ADODB.Recordset
    ' Level 3 nodes
    Dim rstLevel3 As ADODB.Recordset
    ' Level 4 nodes
    Dim rstLevel4 As ADODB.Recordset

    Dim strConnectionString As String
    Dim strShapeCommand As String

    Set cnn = New ADODB.Connection

    ' Invoke the Data Shaping Service for OLE DB in your connection string
    strConnectionString = "Provider=MSDataShape;Data " & CurrentProject.Connection.ConnectionString
    cnn.ConnectionString = strConnectionString

    Set rstLevel1 = New ADODB.Recordset

    ' Build nested relation hierarchy 4 levels deep.
    strShapeCommand = "SHAPE {SELECT * from tblNodes WHERE ParentNodeID = 0 } " & _
                      "APPEND ((SHAPE {SELECT * from tblNodes } " & _
                      "APPEND ((SHAPE {SELECT * from tblNodes } " & _
                      "APPEND ({SELECT * from tblNodes} AS Level4 " & _
                      "RELATE NodeID TO ParentNodeID)) AS Level3 " & _
                      "RELATE NodeID TO ParentNodeID)) AS Level2 " & _
                      "RELATE NodeID TO ParentNodeID)"

    rstLevel1.Open strShapeCommand, cnn, adOpenStatic, adLockReadOnly, adCmdText

   ' Print hierarchical data.
   ' Level 1
    While Not rstLevel1.EOF
        Debug.Print rstLevel1("NodeName")
        Set rstLevel2 = rstLevel1("Level2").Value

        ' Level 2
        While Not rstLevel2.EOF
            Debug.Print Space(3) & rstLevel2(1)
            Set rstLevel3 = rstLevel2("Level3").Value

                ' Level 3
                While Not rstLevel3.EOF
                    Debug.Print Space(6) & rstLevel3(1)
                    Set rstLevel4 = rstLevel3("Level4").Value

                    ' Level 4
                    While Not rstLevel4.EOF
                        Debug.Print Space(9) & rstLevel4(1)

  On Error Resume Next
  rstLevel1.Close: Set rstLevel1 = Nothing
  rstLevel2.Close: Set rstLevel2 = Nothing
  rstLevel3.Close: Set rstLevel3 = Nothing
  rstLevel4.Close: Set rstLevel4 = Nothing
  cnn.Close: Set cnn = Nothing
  Exit Sub

  MsgBox "Error: Test " & Err.Number & " : " & Err.Description
  Resume Exit_Test

End Sub

===End Code============================================== =============

The SHAPE command adds each recordset object to the fields collection of its parent recordset object.



Old July 10th, 2004, 01:05 AM
Registered User
Join Date: Jul 2004
Posts: 2
Thanks: 0
Thanked 0 Times in 0 Posts

thanks Bob bt u know as in accounts.no one can define the levels
before.they can exceeed.
so my dear can u guide me more how to execute the recursive query more fast.
as right now i am papulating this hirearchy in tree view control
by using a recursive Function in visual basic.
bt when i open the form it get strucks for a while then it shows the tree kindly guide me.
thanks for ur co-orporation.

Old July 10th, 2004, 02:14 AM
Friend of Wrox
Join Date: Jun 2003
Posts: 1,093
Thanks: 1
Thanked 12 Times in 11 Posts

Hi shery,

Here is a non-recursive, top-down technique for populating a treeview control with data from a self-referencing table developed by Sarah Worthen. The code includes a call to the Timer function that you can use during development. You should find the non-recursive approach to be about 2 to 3 times faster than using recursion.

The trick to the technique is to use a little constructive error trapping. As the code loops through the recodset, it attempts to set mNodeParent equal to a node already in the tree whose 'childID'
matches the 'parentID' of the current record. If the matching node isn't present, error 35601 is trapped and processed; if the matching node is present, a new node is added to the tree.

The code is using a classic Employee/Supervisor equi-join scenario:

Table: tblEmployees
Join: [EmployeeID] <-> [SupervisorID]

Field: EmployeeID
Type: Number

Field: EmpLastNAme
Type: Text

Field: EmpFirstName
Sort: Text

Field: SupervisorID
Sort: Number

Query: EmployeesAndSupervisors
Type: Select Query

Field: SupervisorID

Field: EmployeeID

Field: EmployeeName

Field: SupervisorName


SELECT tblEmployees.SupervisorID, tblEmployees.EmployeeID, tblEmployees.EmpLastName AS EmployeeName, tblEmployees_1.EmpLastName AS SupervisorName
FROM tblEmployees LEFT JOIN tblEmployees AS tblEmployees_1 ON tblEmployees.SupervisorID = tblEmployees_1.EmployeeID
WHERE (((tblEmployees.SupervisorID) Is Not Null))
ORDER BY tblEmployees.SupervisorID, tblEmployees.EmployeeID, tblEmployees.EmpLastName;

The recordset opened in the code uses the query as its source.


Option Compare Database
Option Explicit

Private Sub Form_Load()
On Error GoTo Error
    'fill the treeview with the records from the table

    Dim timStart As Single
    Dim timEnd As Single

    timStart = Timer

    Dim rst As Recordset
    Dim db As Database

    Dim mNodeParent As node
    Dim mNodeChild As node

    Dim fExists As Boolean

    Set db = CurrentDb()
    Set rst = db.OpenRecordset("qryEmployeesAndSupervisors")

    Application.Echo False

    Do Until rst.EOF
        'assume the parent node is already in the tree. If not, the next line
        'will cause error 35601 - Element Not Found
        'Trap the error, and at that point add the missing parent.

        Set mNodeParent = TreeView.Nodes("Key_" & rst("SupervisorID"))

        Set mNodeChild = TreeView.Nodes.Add( _
            relative:=mNodeParent.Index, _
            relationship:=tvwChild, _
            Key:="Key_" & rst("EmployeeID"), _

        With mNodeChild
            'set other properties
        End With


    Loop 'through recordset

    Application.Echo True

    For Each mNodeChild In TreeView.Nodes
      mNodeChild.Expanded = False

    timEnd = Timer
    MsgBox "Non-recursive form load took " & timEnd - timStart & " seconds!"

Exit Sub

    Select Case Err.Number
        Case 35601 'node does not exist
            Set mNodeParent = AddParentNode( _
                Key:="Key_" & rst("SupervisorID"), _
            Resume Next

        Case 35602 'duplicated node key
            'if we are duplicating the key, we have "misfiled" node.
            'move the existing node with its children to report to the correct parent
            Call AssignNewParent( _
                Key:="Key_" & rst("EmployeeID"), _
            Resume Next
        Case Else
            Application.Echo True
            MsgBox Err.Number & ": " & Err.Description
    End Select
End Sub

Private Function AddParentNode(Key As String, Text As String) As node
On Error GoTo Error

Dim mNodeParent As node

Set mNodeParent = TreeView.Nodes.Add(, , Key, Text)
  With mNodeParent
    'other properties
  End With

Set AddParentNode = mNodeParent

Exit Function
  Application.Echo True
  MsgBox Err.Number & ": " & Err.Description
End Function

Private Sub AssignNewParent(Key As String, ParentNodeIndex As Integer)
On Error GoTo Error

Set TreeView.Nodes(Key).Parent = _

Exit Sub
  Application.Echo True
  MsgBox Err.Number & ": " & Err.Description
End Sub




Similar Threads
Thread Thread Starter Forum Replies Last Post
Irregular shaped button watashi Visual C++ 2 November 22nd, 2017 11:36 AM
Argent Custmization in Required Field validator shivendra012 ASP.NET 2.0 Professional 0 April 18th, 2007 02:43 AM
shaped form!!!! help me angelboy C# 2005 2 February 18th, 2007 09:16 AM
shaped form angelboy C# 2005 0 January 19th, 2007 03:02 PM
database restore using sql command very argent!! foka SQL Server 2000 2 December 10th, 2003 01:25 PM

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.