I have adapted the code below but it gives me an error "exception occcured"
after the first recursion.
Any ideas what can be done to make the following code work.
Thanks
<!--#include file="conn.asp"-->
<!-- #include file="adovbs.inc" -->
<%
strUserId = session("UserId")
set rs = Server.createobject ("adodb.recordset")
SQL = " SELECT HolidayEntitlement, EmpName, ManagerName, EmployeeNumber,
FirstName, LastName, left FROM EMPProfile;"
rs.Open SQL, conn, adOpenKeyset, adLockOptimistic, adCmdText
Set empRs = Rs.Clone()
' Get the top level manager
Rs.Filter = "ManagerName = '" & session("username") & "'"
' Loop through this recordset
Do While Not Rs.EOF
Response.Write(Rs("FirstName") & " " & Rs("LastName")) & "<br>"
' Recurse for every person directly under this manager
RecurseEmp Rs("EmpName"), 1
Rs.MoveNext
Loop
' The recursion continues until an employee is not
' a manager.
Sub RecurseEmp (ManagerName, level)
' Filter the employee records for people who work
' for this manager directly
empRs.Filter = "ManagerName='" & ManagerName & "'"
Do While Not empRs.EOF
' Print spaces for this level
Response.Write " "
' Print this person's name
Response.Write(empRs("FirstName") & " " & empRs("LastName")) & "<br>"
' Recurse for this employee -- check if there are employees
' under this person
' THIS IS WHERE I AM HAVING THE PROBLEM
' IF I COMMENT THE LINE BELOW IT WORKS ALL
' OKAY AND DOES DISPLAY THE EMPLOYEES 1
' LEVEL DOWN FROM THE MAIN
RecurseEmp empRs("EmpName"), Level + 1
empRs.MoveNext
Loop
End Sub
%>
Sub RecurseEmp (ManagerName, level)
Dim cursorPosition
' Filter the employee records for people who work
' for this manager directly
empRs.Filter = "ManagerName='" & ManagerName & "'"
Do While Not empRs.EOF
' Print spaces for this level
Response.Write " "
' Print this person's name
Response.Write(empRs("FirstName") & " " & empRs("LastName")) & "<br>"
' Note the cursor position
cursorPosition = empRs.AbsolutePosition
' Recurse for this employee -- check if there are employees
' under this person
' THIS IS WHERE I AM HAVING THE PROBLEM
' IF I COMMENT THE LINE BELOW IT WORKS ALL
' OKAY AND DOES DISPLAY THE EMPLOYEES 1
' LEVEL DOWN FROM THE MAIN
RecurseEmp empRs("EmpName"), Level + 1
' Set the cursor back to where you were before recursing
empRs.Filter = "ManagerName='" & ManagerName & "'"
empRs.AbsolutePosition = cursorPosition
empRs.MoveNext
Loop
End Sub
--
Manohar Kamath
Editor, .netWire
www.dotnetwire.com
"JP SIngh" <no...@none.com> wrote in message
news:upFE30JG...@TK2MSFTNGP12.phx.gbl...
ADODB.Recordset error '800a0bcd'
Either BOF or EOF is True, or the current record has been deleted. Requested
operation requires a current record.
/teamholidays.asp, line 65
Line 65 is empRs.MoveNext
If I put an if condition around the line
if not empRs.eof then
empRs.MoveNext
end if
Then it does display the above error but only shows one employee for each
manager and goes only one level down
Thanks for your efforts and help, Much appreciated.
"Manohar Kamath [MVP]" <mka...@TAKETHISOUTkamath.com> wrote in message
news:%23R9089K...@TK2MSFTNGP12.phx.gbl...
<html>
<body>
<%
Dim loConn
Dim empRs
Dim Rs
Dim cursorPos
Set loConn = Server.Createobject("adodb.connection")
loConn.Open "Provider=sqloledb;Data source=localhost;Initial
Catalog=Test1;uid=test;pwd=test;"
loConn.CursorLocation = 3
Set empRs = Server.Createobject("adodb.recordset")
' Retrieve the employee records
Set empRs = loConn.Execute("select * from Emp")
' Disconnect the recordset
Set empRs.ActiveConnection = Nothing
loConn.Close
Set loConn = Nothing
' Filter for top-level employees
empRs.Filter = "MgrID = Null"
' Loop through top level employees
Do While Not empRs.EOF
' Mark the position in the recordset
cursorPos = empRs.AbsolutePosition
' Print the names of top level employees
Response.Write("<br>" & empRs("EmpName"))
' Recurse to employees below
' !!!NOTE: The "value" is important!!!
Recurse empRs("EmpID").value, 1
' Reset the cursor to where we left off
empRs.Filter = "MgrID = Null"
empRs.AbsolutePosition = cursorPos
empRs.MoveNext
Loop
Set empRs = Nothing
Sub Recurse (empID, Level)
Dim cursorPos
' Filter for the people under this employee
empRs.Filter = "MgrID=" & empID
' Loop through subordinates
Do While Not empRs.EOF
' Mark the position in the recordset
cursorPos = empRs.AbsolutePosition
' Write out the employee name
Response.Write("<br>" & String(Level, "-") & empRs("empName"))
' Recurse to one level below this person
' !!!NOTE: The "value" is important!!!
Recurse empRs("empID").value, Level + 1
' This is where recursion returns, filter the recordset back
empRs.Filter = "MgrID=" & empID
' Set the cursor position to where it was before we recursed
empRs.AbsolutePosition = cursorPos
empRs.MoveNext
Loop
End Sub
%>
</body>
</html>
--
Manohar Kamath
Editor, .netWire
www.dotnetwire.com
"JP SIngh" <no...@none.com> wrote in message
news:uM%23tIRLG...@TK2MSFTNGP10.phx.gbl...
Have you considered using an XSLT transform? Here's a proof of concept:
[list2tree.xsl]
<?xml version="1.0" encoding="utf-8"?>
<xsl:stylesheet version="1.0"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output method="html" version="4.0" indent="yes"/>
<xsl:template match="root">
<html>
<body>
<ul>
<xsl:apply-templates select="row[@EmployeeNumber=@ManagerNumber]"/>
</ul>
</body>
</html>
</xsl:template>
<xsl:template match="row">
<li>
<xsl:value-of select="concat(@FirstName,' ',@LastName)"/>
<xsl:if test="count(../row[@ManagerNumber=current()/@EmployeeNumber
and @EmployeeNumber!=current()/@EmployeeNumber])>0">
<ul>
<xsl:apply-templates
select="../row[@ManagerNumber=current()/@EmployeeNumber and
@EmployeeNumber!=current()/@EmployeeNumber]"/>
</ul>
</xsl:if>
</li>
</xsl:template>
</xsl:stylesheet>
[showtree.asp]
<%
Dim cn : Set cn = CreateObject("ADODB.Connection")
Dim cmd : Set cmd = CreateObject("ADODB.Command")
cn.Open "<<Your DSN-Less OLEDB connection string here>>"
Set cmd.ActiveConnection = cn
cmd.CommandText = "SELECT EmployeeNumber, FirstName, LastName,
ManagerNumber FROM [Profile] FOR XML RAW"
cmd.Properties("XML Root")= "root"
cmd.Properties("XSL") = Server.MapPath("list2tree.xsl")
cmd.Properties("Output Stream") = Response
cmd.Execute ,,1025 'adCmdText & adExecuteStream
Set cmd = Nothing
cn.Close : Set cn = Nothing
%>
HTH
-Chris Hohmann