Representing a tree structure in an RDBMS system

Question

I'd like to store assembly units data together with their structure in my database to be able to print assembly unit hierarchy tree traversal and to calculate assembly unit price. How can I do that?
Answer

Here is one of the possible solutions:
Option Compare Database 
Option Explicit

'*+
'  Purpose:
'           - Create sample tables representing assembly units hierarchy
'           - Load sample tables with sample data
'           - Calculate assembly price
'           - Debug.print units hierarchy traversal tree
'
'  Written by Shamil Salakhetdinov in January 1995
'
'*-
Dim sSql
Dim TotPrice
Dim ChildPrice
Dim OrdKey

Sub Test()
   On Error GoTo ErrProc

   DoCmd.SetWarnings False
   DoCmd.RunSQL "DROP TABLE [Units Hierarchy];"
   DoCmd.RunSQL "DROP TABLE [Unit];"
   DoCmd.RunSQL "DROP TABLE [Units Traversal];"
   
   sSql = "CREATE TABLE [Units Hierarchy] ( ParentID Long, ChildId Long, "
   sSql = sSql & "CONSTRAINT PrimaryKey PRIMARY KEY ( ParentID, ChildID) );"
   DoCmd.RunSQL sSql
   
   sSql = "CREATE TABLE Unit (UnitID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, "
   sSql = sSql & "UnitPrice CURRENCY, BaseUnitFlag BIT);"
   DoCmd.RunSQL sSql
   
   sSql = "CREATE TABLE [Units Traversal] (OrdNum INTEGER,Level BYTE,ParentId LONG,ChildId LONG,"
   sSql = sSql & " Price CURRENCY,BaseUnitFlag BIT,LastFlag BIT,CONSTRAINT OrdNum PRIMARY KEY ( OrdNum))"
   DoCmd.RunSQL sSql
   
   DoCmd.SetWarnings True
   
   LoadUnit
   LoadUnitsHierarchy
   TotPrice = CalcAssemblyPrice(1, 0, 1)
   
   Debug.Print
   Debug.Print "TotPrice = "; TotPrice

'
'* --- The DEBUG window printing
'
' 1              1300 [ Assembly ]
' |
' +-2            600 [ Assembly ]
' | |
' | +-3          100 * Base unit *
' | |
' | *-4          500 * Base unit *
' |
' +-5            300 * Base unit *
' |
' *-6            400 [ Assembly ]
'   |
'   +-7          300 [ Assembly ]
'   | |
'   | +-8        100 * Base unit *
'   | |
'   | *-9        200 * Base unit *
'   |
'   *-10         100 * Base unit *
'
'*
'
'
' TotPrice = 1300
'

   Exit Sub

ErrProc:
   If Err <> 3376 Then
    Error Err
   End If
   Resume Next
End Sub

Function CalcAssemblyPrice(ParentID, Level, OrdNum)
 
 Dim db As Database, r As Recordset, p As Recordset, u As Recordset
 Dim rSql, ChildId, TotPrice As Single, BaseUnitFlag
 
 Set db = DBEngine(0)(0)
 Set p = db.OpenRecordset("Units Traversal", DB_OPEN_TABLE)
 Set u = db.OpenRecordset("Unit", DB_OPEN_TABLE)

 TotPrice = 0
 If Level = 0 Then
  DoCmd.SetWarnings False
  DoCmd.RunSQL "Delete * from [Units Traversal];"
  DoCmd.SetWarnings True
  p.AddNew
    p!Level = Level
    p!OrdNum = OrdNum
    p!ParentID = 0
    p!ChildId = ParentID
  p.Update
  Level = Level + 1
  OrdNum = OrdNum + 1
 End If

 rSql = "SELECT DISTINCTROW [Units Hierarchy].* FROM [Units Hierarchy] WHERE (([Units Hierarchy].ParentId=" & ParentID & "));"
 Set r = db.OpenRecordset(rSql)
 If Not r.EOF Then
  r.MoveFirst
  While Not r.EOF
   ChildId = r!ChildId
   BaseUnitFlag = False

   u.Index = "PrimaryKey"
   u.Seek "=", ChildId
   If u.NoMatch Then
    ChildPrice = 0
   Else
    BaseUnitFlag = IIf(u!BaseUnitFlag, True, False)
    ChildPrice = u!UnitPrice
   End If
   
   
   r.MoveNext
   p.AddNew
    p!Level = Level
    p!OrdNum = OrdNum
    p!ParentID = ParentID
    p!ChildId = ChildId
    p!Price = 0
    p!BaseUnitFlag = BaseUnitFlag
    p!LastFlag = IIf(r.EOF, True, False)
   p.Update
   r.MovePrevious
   OrdKey = OrdNum
   OrdNum = OrdNum + 1
   
   ChildPrice = ChildPrice + CalcAssemblyPrice(ChildId, Level + 1, OrdNum)
   TotPrice = TotPrice + ChildPrice

   p.Index = "OrdNum"
   p.Seek "=", OrdKey
   p.Edit
    p!Price = ChildPrice
   p.Update

   r.MoveNext
  Wend
 End If
 
 CalcAssemblyPrice = TotPrice

 If Level = 1 Then
   p.Index = "OrdNum"
   p.Seek "=", 1
   p.Edit
    p!Price = TotPrice
   p.Update
  
  
  PrintUnitsTraversal
 End If

 r.Close
 p.Close
 u.Close

End Function

Sub LoadUnit()
 Dim db As Database, u As Recordset
 Set db = DBEngine(0)(0)
 Set u = db.OpenRecordset("Unit", DB_OPEN_TABLE)

 LoadUnitRow u, 1, 0#, False
 LoadUnitRow u, 2, 0#, False
 LoadUnitRow u, 3, 100#, True

 LoadUnitRow u, 4, 500#, True
 LoadUnitRow u, 5, 300#, True
 LoadUnitRow u, 8, 100#, True
 LoadUnitRow u, 9, 200#, True
 LoadUnitRow u, 10, 100#, True

 u.Close

End Sub

Sub LoadUnitRow(u As Recordset, UnitId, UnitPrice, BaseUnitFlag)

 u.AddNew
  u!UnitId = UnitId
  u!UnitPrice = UnitPrice
  u!BaseUnitFlag = BaseUnitFlag
 u.Update
 
End Sub

Sub LoadUnitsHierarchy()
 Dim db As Database, u As Recordset
 Set db = DBEngine(0)(0)
 Set u = db.OpenRecordset("Units Hierarchy", DB_OPEN_TABLE)

 LoadUnitsHierarchyRow u, 1, 2
 LoadUnitsHierarchyRow u, 1, 5
 LoadUnitsHierarchyRow u, 1, 6

 LoadUnitsHierarchyRow u, 2, 3
 LoadUnitsHierarchyRow u, 2, 4
 LoadUnitsHierarchyRow u, 6, 7
 LoadUnitsHierarchyRow u, 6, 10
 LoadUnitsHierarchyRow u, 7, 8
 LoadUnitsHierarchyRow u, 7, 9

 u.Close

End Sub

Sub LoadUnitsHierarchyRow(u As Recordset, ParentID, ChildId)
 u.AddNew
 u!ParentID = ParentID
 u!ChildId = ChildId
 u.Update
End Sub

Sub PrintUnitsTraversal()
  Dim db As Database, p As Recordset, MaxLevel, i, ll(), PrFlag
  Set db = DBEngine(0)(0)
  Set p = db.OpenRecordset("Units Traversal")
  
  MaxLevel = DMax("[Level]", "Units Traversal")
  ReDim ll(MaxLevel)
  For i = 0 To MaxLevel
   ll(i) = False
  Next i

  If Not p.EOF Then
   p.MoveFirst
   While Not p.EOF

    PrFlag = False
    For i = 1 To p!Level
     If ll(i) Then
      Debug.Print "  ";
      PrFlag = True
     Else
      Debug.Print "| ";
      PrFlag = True
     End If
    Next i
    If PrFlag Then Debug.Print
    
    For i = 1 To p!Level - 1
     If ll(i) Then
      Debug.Print "  ";
     Else
      Debug.Print "| ";
     End If
    Next i

    If p!LastFlag Then
     ll(p!Level) = True
    Else
     ll(p!Level) = False
    End If

     If p!Level <> 0 Then
     If ll(p!Level) Then
      Debug.Print "*-";
     Else
      Debug.Print "+-";
     End If
    End If
    Debug.Print Trim(CStr(p!ChildId)), p!Price;
    
    If p!BaseUnitFlag Then
      Debug.Print "* Base unit *"
    Else
      Debug.Print "[ Assembly ]"
    End If

    If p!Level <> MaxLevel Then
     For i = p!Level + 1 To MaxLevel
      ll(i) = False
     Next i
    End If
    
    p.MoveNext
   Wend
  End If

End Sub