how to covert a table into a tree structure?

Question

Hi,

I have a table like below:

Parent	Component
A	A1
A	A2
A	A3
A	A4
A	A5
A1	A6
A1	A7
A1	A8
A1	A9

And I want create a procedure using VBA to output the table like this:

1)

Level	Part
0	A
.1	A1
..2	A6
..2	A7
..2	A8
..2	A9
.1	A2
.1	A3
.1	A4
.1	A5

or 2)

Level_0	Level_1	Level_2
A
	A1
		A6
		A7
		A8
		A9
	A2
	A3
	A4
	A5

Answer 1

Create the following function in a module in the Visual Basic Editor:

Function Lvl(ByVal Component As String) As Long
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("tblComponents", dbOpenDynaset)
    Do
        rst.FindFirst "Component='" & Component & "'"
        If rst.NoMatch Then
            Lvl = -1
            Exit Do
        ElseIf IsNull(rst!Parent) Then
            Exit Do
        Else
            Lvl = Lvl + 1
            Component = rst!Parent
        End If
    Loop
    rst.Close
End Function

Here, tblComponents is the name of the table. Create a query like this:

SELECT Component, Lvl(Component) AS Lvl
FROM tblComponents

or

TRANSFORM First(Component) AS FirstOfComponent
SELECT Component
FROM tblComponents
GROUP BY Component
PIVOT Lvl(Component)

PS I avoided the name Level since it is a reserved word.

---

Regards, Hans Vogelaar (http://www.eileenslounge.com)

Answer 2

Since Access SQL does not support recursive queries, a helper function like Hans showed is your best option. If your app is all about trees, consider using SQL Server, which T-SQL language has native support for recursive queries.

---

-Tom. Microsoft Access MVP

Answer 3

Thanks,Hans.

the Lvl function is very helpful to me. And I create a Level function referring to yours.

But I found a bug when the table is like the below:

<tfoot></tfoot>

Table1

Parent	Component
A	B
B	C
C	D
D	E
A	C
A	D
A	E

Function Get_Level(Parent_1 As String, Component_1 As String) As Long
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    Dim mySQL As String
    Get_Level = 0
    Do
        Set rs = Nothing
        mySQL = "SELECT DISTINCT Parent FROM Table1 WHERE Component = " & Chr(34) & Component_1 & Chr(34)
        rs.Open mySQL, cn, adOpenForwardOnly, adLockOptimistic
        If rs.EOF = True Then
            Exit Do
        Else
            Get_Level = Get_Level + 1
            If Parent_1 = rs.Fields(0) Then
                Exit Do
            Else
                Component_1 = rs.Fields(0)
            End If
        End If
    Loop
    Set rs = Nothing
    Set cn = Nothing
End Function

'/********Recursive - Find its components*************/

Option Compare Database
Option Explicit
Option Base 1
Public i As String
Sub test()
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM Table2"
DoCmd.RunSQL "DELETE * FROM Table3"
Debug.Print 0 & Chr(9) & "A"
Call WriteTable("0", "A")
Call WriteTable3("0", "A")
Extend_BOM_Structure_1 ("A")
End Sub
Sub Extend_BOM_Structure_1(Part As String)
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    Dim mySQL As String
    Dim k As Long
    mySQL = "SELECT Component FROM Table1 WHERE Parent = " & Chr(34) & Part & Chr(34)
    rs.Open mySQL, cn, adOpenForwardOnly, adLockBatchOptimistic
    With rs
        Do While Not .EOF
            i = ConvertWith_DOT(Get_Level("a", .Fields(0)))
            Debug.Print (i) & Chr(9) & .Fields(0)
            Call WriteTable((i), .Fields(0))
            Call WriteTable3((i), .Fields(0))
            Call Extend_BOM_Structure_1(.Fields(0))
            .MoveNext
        Loop
    End With
    Set rs = Nothing
    Set cn = Nothing
End Sub



Sub WriteTable(myLevel As String, myPart As String)
    
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    
    rs.Open "Table2", cn, adOpenForwardOnly, adLockOptimistic
    
    DoCmd.SetWarnings False
    
    With rs
        
        .AddNew
        
        .Fields("myLevel") = myLevel
        .Fields("myPart") = myPart
        
    End With
    
    rs.Update
    
    Set rs = Nothing
    Set cn = Nothing
    

End Sub


Sub WriteTable3(myLevel As String, myPart As String)
    
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    
    rs.Open "Table3", cn, adOpenForwardOnly, adLockOptimistic
    
    DoCmd.SetWarnings False
    
    With rs
        
        .AddNew
        
        .Fields(CInt(Right(myLevel, 1))) = myPart
        
    End With
    
    rs.Update
    
    Set rs = Nothing
    Set cn = Nothing
    

End Sub

The output Lvl is like this: 

<tfoot></tfoot>

Table2

myLevel	myPart
0	A
.1	B
.1	C
.1	D
.1	E
.1	C
.1	D
.1	E
.1	D
.1	E
.1	E

Acutally, the right order should be like this:

<tfoot></tfoot>

Table2

myLevel	myPart
0	A
.1	B
..2	C
...3	D
....4	E
.1	C
..2	D
...3	E
.1	D
..2	E
.1	E

Answer 4

Hi, Tom

I tried it using T-SQL to generate the tree. but the the level is out of order.

Anyway, using T-SQL CTE expression is a good choice to do it.

Table_1

Parent Component
A         B         
B         C         
C         D         
D         E         
D         ZZ1       
D         ZZ2       
C         X3        
B         Y80       
Y80       77X       

QUERY: 

WITH myPart(Part,myLevel)

AS
(
SELECT  (Component), 1 as myLevel FROM Table_1 WHERE Parent = N'A'

UNION ALL

SELECT component, mylevel+1 FROM Table_1 INNER JOIN mypart on Table_1.parent = mypart.part

)
SELECT N'0' as Lvl, 'A' 
UNION ALL
SELECT myLevel, part FROM myPart
GO

OUTPUT:

Lvl (无列名)
0 A
1 B         
2 C         
2 Y80       
3 77X       
3 D         
3 X3        
4 E         
4 ZZ1       
4 ZZ2       

I think the proper order should be like this:

<tfoot></tfoot>

Table2

myLevel	myPart
0	A
.1	B
..2	C
...3	D
....4	E
....4	ZZ1
....4	ZZ2
...3	X3
..2	Y80
...3	77X

Answer 5

In your Table1, components C, D and E have multiple parents. Is that intentional?

---

Regards, Hans Vogelaar (http://www.eileenslounge.com)

Answer 6

Hi, Hans

This exists in the real business. e.g. Both Item A and B will use component C(like the auxiliary material detergent) to clean its surface.

Answer 7

Hi, Chester Wu123

If you use T-SQL currently, you could create User-Defined function to change Lvl "0,1,2" into "0,.1,..2".

For more information, click here to refer about Create User-defined Functions (Database Engine)

Answer 8

A bill of materials or parts explosion is not a tree, mathematically speaking, as there can be multiple paths between nodes.  The classic model is an adjacency list, which your table represents.  Recursive querying down to an arbitrary number of levels is, as Tom points out, not  supported by Access SQL, but can be simulated.  You'll find an example as BoM.zip in my public databases folder at:

https://onedrive.live.com/?cid=44CC60D7FEA42912&id=44CC60D7FEA42912!169

Note that if you are using an earlier version of Access you might find that the colour of some form objects such as buttons shows incorrectly and you will need to  amend the form definition accordingly.  

If you have difficulty opening the link copy its text (NB, not the link location) and paste it into your browser's address bar.

As well as the main BoM file this little demo file includes an example of the simpler means of generating a bill of materials to a fixed number of levels, presenting the BoM as an indented report.

---

Ken Sheridan, Stafford, England

Answer 9

The function that I posted was a bottom-up approach. That will not work for a BOM. Use a top-down approach instead:

Private cnn As ADODB.Connection

Sub Test2()
    Set cnn = CurrentProject.Connection
    cnn.Execute "DELETE * FROM Table2"
    cnn.Execute "DELETE * FROM Table3"
    AddLevel Level:=0, Parent:="A"
    Set cnn = Nothing
End Sub

Sub AddLevel(ByVal Level As Long, ByVal Parent As String)
    Dim rst As New ADODB.Recordset
    cnn.Execute "INSERT INTO Table2 (myLevel, myPart) VALUES (" & Level & ", '" & Parent & "')"
    cnn.Execute "INSERT INTO Table3 (Level_" & Level & ") VALUES('" & Parent & "')"
    rst.Open Source:="SELECT Component FROM Table1 WHERE Parent = '" & Parent & "'", ActiveConnection:=cnn
    Do While Not rst.EOF
        AddLevel Level:=Level + 1, Parent:=rst!Component
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
End Sub

---

Regards, Hans Vogelaar (http://www.eileenslounge.com)