Hi,
If the number of generations is relatively high, and in that, I mean 4 or
more, you may investigate a nested set based solution. There is an example
using it, for a bill of material list at
http://www.mvps.org/access/queries/qry0023.htm WITHOUT using any loop. A
nested set acts like an index: it accelerates some operations. In the case
of a nested set, it is about hierachy-like operations.
To make the nested set representation, out of a classical parent-child
table, find below some code that can help. Use the sub
FromParentToNested(ByVal ParentTable As String, _
ByVal NodeID As String, _
ByVal ParentID As String, _
ByVal NestedSet As String)
where the first argument is the table name for the parent-child; the second
argument is the name of the field identifying the "thing", ( the part
number, the name of the employee in a boss-employee relation, etc); the
third field is the name of the field being the parent of the previous field,
and the last argument is the table name to be created that would be the
nested set table representation. Once you have the nested set
representation, you can use all kinds of relations, without using any loop.
I also have a 2003 database, with documents, that, under the form of a
"wizard", can help you to explore some of the things we can do with nested
sets. Just send me a message if you are interested, so I can send it to you.
Hoping it may help,
Vanderghast, Access MVP
================
Option Compare Database
Option Explicit
Private Const MyName As String = "NestedSets"
Private Const errParentTable As String = "Parent Table in error."
Private Const errParentTableKey As String = "Specified 'node' field in
Parent Table has null and so can't be use for primary key."
Private Const errNoRoot As String = "The Parent table has no identifiable
root node; fix and submit again."
Private Const errNoUniqueRoot As String = "The Parent table has more than
one possible root; fix and submit again."
Private Const errCantCreate As String = "Cannot create the nested set table
("
Private Const errCantInsert As String = "Cannot insert the nodeID "
Private Const errUnknownParent As String = "At least one ParentID is unknown
as NodeID in the supplied table."
Private Const errUnusedRecords As String = "Not all the records from the
table have been used."
Private db As Database ' To avoid using CurrentDb each time
Private OpeningString As String ' string to open the recordset with all
children
Private InsertInto As String ' string to insert a record
Private Sub RaiseError(ByVal Desc As String, Optional ErrNumber As Long =
513)
Err.Raise vbObjectError + ErrNumber, MyName, Desc
End Sub
Public Sub FromNestedToParent(ByVal NestedTable As String, _
ByVal ParentTableName As String, _
ByVal NodeFieldName As String, _
ByVal ParentFieldName As String)
Dim db As Database: Set db = CurrentDb
On Error Resume Next
db.Execute "DROP TABLE " & ParentTableName
Err.Clear
db.Execute "SELECT c.NodeID as " & NodeFieldName & _
", p.NodeID As " & ParentFieldName & _
" INTO " & ParentTableName & _
" FROM " & NestedTable & " AS c LEFT JOIN " & NestedTable & " AS p "
& _
" ON (c.lft BETWEEN p.lft AND p.rgt) AND c.lvl = p.lvl+1 ",
dbFailOnError
If 0 <> Err.Number Then
RaiseError Err.Description, Err.Number
End If
Debug.Assert 0 = Err.Number
End Sub
Public Sub FromParentToNested(ByVal ParentTable As String, _
ByVal NodeID As String, _
ByVal ParentID As String, _
ByVal NestedSet As String)
Dim nCount As Long
' Check if the table exists, and if the fields NodeID and ParentID exist
On Error Resume Next
DCount "*", ParentTable, NodeID & "=" & ParentID
If 0 <> Err.Number Then
RaiseError errParentTable
Exit Sub
End If
' Check if there are NULL under the nodeID
If 0 <> DCount("*", ParentTable, NodeID & " IS NULL") Then
RaiseError errParentTableKey
Exit Sub
End If
Set db = CurrentDb
If 0 <> db.OpenRecordset("SELECT COUNT(*) FROM (SELECT * FROM " &
ParentTable & " AS a LEFT JOIN " & _
ParentTable & " AS b ON a." & ParentID & "= b." & NodeID & _
" WHERE (NOT a." & ParentID & " IS NULL) AND b." & NodeID & " IS
NULL)").Fields(0).Value Then
RaiseError errUnknownParent
Exit Sub
End If
' Create the nested set table. Its three fields are NodeID, lft and rgt.
db.Execute "DROP TABLE " & NestedSet: Err.Clear
' We tried to drop a table, maybe it was not there... not important...
db.Execute "CREATE TABLE " & NestedSet & _
"(NodeID LONG CONSTRAINT PrimaryKey PRIMARY KEY," & _
" lft LONG NOT NULL CONSTRAINT UniqueLft UNIQUE, " & _
" rgt LONG NOT NULL CONSTRAINT UniqueRgt UNIQUE, " & _
" lvl LONG NOT NULL ); "
'In theory, we can compute the level, lvl, with a query, but there
is
' nothing wrong in storing it in the table too.
If 0 <> Err.Number Then
RaiseError errCantCreate & Err.Description & ")."
Exit Sub
End If
' Find the root, the node with a Null as ParentID, or the one with
itself.
Dim root As Long
Select Case DCount("*", ParentTable, NodeID & "=" & ParentID)
Case 0
' There is no node where NodeID=ParentID... look for a Parent Is
Null
Select Case DCount("*", ParentTable, ParentID & " IS Null")
Case 0
' There is no node where Parent Is Null, ... error...
RaiseError errNoRoot
Exit Sub
Case 1
' there is just one such node, perfect...
root = DLookup(NodeID, ParentTable, ParentID & " IS NULL")
Case Else
' there is more than one node with a parent Is Null... what to
do?
RaiseError errNoUniqueRoot
Exit Sub
End Select
Case 1
' There is just one node where parentID=NodeID... what about
' a node with a NULL parent???
If 0 <> DCount("*", ParentTable, ParentID & " Is Null") Then
RaiseError errNoUniqueRoot
Exit Sub
End If
root = DLookup(NodeID, ParentTable, ParentID & "=" & NodeID)
Case Else
' We have more than one node with ParentID=NodeID, someone has to
fix it...
RaiseError errNoUniqueRoot
Exit Sub
End Select
If 0 <> Err.Number Then
RaiseError errCantInsert & root
Exit Sub
End If
' Prepare the recursion
InsertInto = "INSERT INTO " & NestedSet & "(NodeID, lft, rgt, lvl)
VALUES("
OpeningString = "SELECT " & NodeID & " FROM " & ParentTable & " WHERE "
& ParentID & "="
Dim counting As Long
counting = 2
'Make some nasty recursion about calling for each of the children
CallChildren root, counting, 2
' Append the root...
db.Execute InsertInto & root & ", 1, " & counting & ", 1 ); "
'Job is done... we can alter the rgt field so it doesn't accept NULLs
anymore
' but that is not 'strictly' required...
db.Execute "CREATE INDEX level ON " & NestedSet & "(lvl)"
If counting <> 2 * DCount("*", ParentTable) Then
RaiseError errUnusedRecords
Exit Sub
End If
If 0 <> Err.Number Then
RaiseError Err.Description, Err.Number
Exit Sub
End If
End Sub
Private Sub CallChildren(ByVal ParentNodeID As Long, ByRef counting As Long,
ByVal level As Long)
Dim rst As DAO.Recordset
Dim opening As Long ' the current worm counter, the lft value
' for a given node
On Error Resume Next
' Open a recordset will al the children of the given parent...
Set rst = db.OpenRecordset(OpeningString & ParentNodeID,
dbOpenForwardOnly, dbReadOnly)
' For each, remember the lft, call the children, then having the rgt
value, insert the record.
Do Until rst.EOF
opening = counting ' get a copy, that is our rgt value.
' we can't insert the whole record,now, since we ignore the rgt
value
' We need to increase the running worm counter...
counting = counting + 1
CallChildren rst.Fields(0).Value, counting, level + 1 ' recursive
call on all the actual children
db.Execute InsertInto & rst.Fields(0).Value & ", " & opening & ", "
& counting & ", " & level & ") ;"
' Increase the running worm counter
counting = counting + 1
rst.MoveNext
Loop
Debug.Assert 0 = Err.Number
End Sub
=======================
