[AccessD] OT: FrontPage Websites

This is the Nodes Class

Option Explicit
Dim NavNodes As Collection
Dim NodesByURL As Collection
Dim strRootURL As String
Dim strRootPath As String
Dim strRootNode As String
Public Function GetPageFromURL(strURL As String) As Node
Set GetPageFromURL = NodesByURL(strURL)
End Function
Property Get ReverseNavByURL(ByVal strCurrentURL As String)
Dim CurrentNode As Node
Dim strRevNav As String
If InternallyGetPageFromURL(CurrentNode, strCurrentURL) Then
    'We have a page
    If CurrentNode.ParentID = 0 Then
        strRevNav = "&nbsp"
    Else
        strRevNav = "<nobr>" & CurrentNode.Title & "<--- </nobr>"
    End If
    Do Until CurrentNode.ParentID = 0
        Set CurrentNode = NavNodes("ID:" & CurrentNode.ParentID)
        strRevNav = strRevNav & "<nobr><a href=""/" & CurrentNode.URL &
""" style="" color: #000000; font-size: 8pt"">" & CurrentNode.Title &
"<---</a></nobr>&nbsp"
    Loop
Else
    ReverseNavByURL = "&nbsp"
End If
End Property
Private Function InternallyGetPageFromURL(ByRef nn As Node, ByVal strURL
As String) As Boolean
On Error GoTo ErrorHandler
Set nn = NodesByURL(strURL)
InternallyGetPageFromURL = True
Exit Function

ErrorHandler:
Err.Clear
InternallyGetPageFromURL = False
End Function
Property Let RootPath(strEnter)
strRootPath = strEnter
End Property
Property Get RootPath()
RootPath = strRootPath
End Property
Property Let RootURL(strEnter)
strRootURL = strEnter
End Property
Property Get RootURL()
RootURL = strRootURL
End Property
Property Get RootNode() As Node
Set RootNode = NavNodes(strRootNode)
End Property
Public Function NewEnum() As IUnknown
Set NewEnum = NavNodes.[_NewEnum]
End Function
Property Get NodeInfo(intPos) As Node
Set NodeInfo = NavNodes(Val(intPos))
End Property
Property Get NodeCount() As Long
NodeCount = NavNodes.Count
End Property
Property Get NodeFromID(intID) As Node
Set NodeFromID = NavNodes("ID:" & intID)
End Property
Function RetrieveNavigation()
Dim f As Long
Dim strData As String
Dim nn As Node
Dim RecordArray() As String
Dim DataArray() As String
Dim i As Long
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim intProductNodeID As Long
Dim nTmp As Node
Set NavNodes = New Collection
Set NodesByURL = New Collection
f = FreeFile
'Open "C:\structure.txt" For Binary Access Read As f
Open "E:\Web2006\_vti_pvt\structure.cnf" & Chr(0) For Binary Access Read
As f
strData = Space(LOF(f))
Get f, , strData
Close f
'Need to deal with commas in the text...
strData = Replace(strData, "\,", Chr(0) & Chr(0) & Chr(0))
RecordArray = Split(strData, vbCrLf)
'Okay, we have the starting node data first
Set nn = New Node
DataArray = Split(RecordArray(2), ",")
nn.ID = Val(DataArray(0))
nn.URL = strRootURL & DataArray(1)
nn.Title = Replace(DataArray(3), Chr(0) & Chr(0) & Chr(0), ",")
nn.ParentID = Val(DataArray(4))
nn.RootNode = True
NavNodes.Add nn, "ID:" & nn.ID
NodesByURL.Add nn, nn.URL
strRootNode = "ID:" & nn.ID
Set nn = Nothing
For i = 4 To UBound(RecordArray)
    Set nn = New Node
    DataArray = Split(RecordArray(i), ",")
    nn.ID = Val(DataArray(0))
    nn.URL = strRootURL & DataArray(1)
    nn.Title = Replace(DataArray(3), Chr(0) & Chr(0) & Chr(0), ",")
    nn.ParentID = Val(DataArray(4))
    nn.RootNode = False
    If Left(nn.URL, 9) = "Products/" Then
        If nn.URL = "Products/products.asp" Then
            intProductNodeID = nn.ID
            NavNodes.Add nn, "ID:" & nn.ID
            NodesByURL.Add nn, nn.URL
        End If
    Else
        NavNodes.Add nn, "ID:" & nn.ID
        NodesByURL.Add nn, nn.URL
    End If
    Set nn = Nothing
Next i
''' Customization Starts here
Set nn = New Node
nn.ID = 0
nn.URL = "Products/productlist.asp?ProductList=AvailableItems"
nn.Title = "Products For Sale Online"
nn.ParentID = intProductNodeID
nn.RootNode = False
NavNodes.Add nn, "ShoppingCartNode"
NodesByURL.Add nn, nn.URL
Set nn = Nothing
Set nn = New Node
nn.ID = 0
nn.URL = "Products/productlist.asp?ProductList=ClearanceItems"
nn.Title = "Clearance Items for Sale"
nn.ParentID = 0
nn.RootNode = False
NavNodes.Add nn, "ClearanceItemsNode"
NodesByURL.Add nn, nn.URL
Set nn = Nothing
DBConnect cnn
Set rs = New ADODB.Recordset
strSQL = "SELECT tblProductTypes.ProductTypeID,
tblProductTypes.ProductTypeName " & _
"FROM tblProductTypes INNER JOIN (tblProducts INNER JOIN
tblProductToProductType ON
tblProducts.ProductID=tblProductToProductType.ProductID) ON
tblProductTypes.ProductTypeID=tblProductToProductType.ProductTypeID " &
_
"GROUP BY tblProductTypes.ProductTypeID,
tblProductTypes.ProductTypeName, tblProducts.VisibleOnProductsPage,
tblProductTypes.SortOrder " & _
"HAVING tblProducts.VisibleOnProductsPage=True " & _
"ORDER BY tblProductTypes.SortOrder"
rs.Open strSQL, cnn, adOpenKeyset, adLockReadOnly
If rs.EOF = False Then rs.MoveFirst
Do Until rs.EOF = True
    Set nn = New Node
    nn.ID = rs.Fields(0).Value
    nn.URL = "Products/productlist.asp?ProductType=" &
rs.Fields(0).Value
    nn.Title = rs.Fields(1).Value
    nn.ParentID = intProductNodeID
    nn.RootNode = False
    NavNodes.Add nn, "ProductTypeID:" & nn.ID
    NodesByURL.Add nn, nn.URL
    Set nn = Nothing
    rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set rs = New ADODB.Recordset
strSQL = "SELECT ProductID, ProductName FROM tblProducts WHERE
VisibleOnProductsPage=True"
rs.Open strSQL, cnn, adOpenKeyset, adLockReadOnly
If rs.EOF = False Then rs.MoveFirst
Do Until rs.EOF = True
    Set nn = New Node
    nn.ID = rs.Fields(0).Value
    nn.URL = "Products/productpage.asp?ProductID=" & rs.Fields(0).Value
    nn.Title = rs.Fields(1).Value
    nn.ParentID = 0
    nn.RootNode = False
    NavNodes.Add nn, "ProductID:" & nn.ID
    NodesByURL.Add nn, nn.URL
    Set nn = Nothing
    rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set rs = New ADODB.Recordset
strSQL = "SELECT ProductTypeID, ProductID FROM tblProductToProductType"
rs.Open strSQL, cnn, adOpenKeyset, adLockReadOnly
If rs.EOF = False Then rs.MoveFirst
Do Until rs.EOF = True
    CreateProductToTypeAssociations "ProductTypeID:" &
rs.Fields(0).Value, rs.Fields(1).Value
    rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set rs = New ADODB.Recordset
strSQL = "SELECT PrimaryProductID, SubProductID FROM
tblPrimaryToSubProducts"
rs.Open strSQL, cnn, adOpenKeyset, adLockReadOnly
If rs.EOF = False Then rs.MoveFirst
Do Until rs.EOF = True
    CreateProductToTypeAssociations "ProductID:" & rs.Fields(0).Value,
rs.Fields(1).Value
    rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set rs = New ADODB.Recordset
strSQL = "SELECT T1.ProductID, T1.ProductName, T1.VisibleOnProductsPage,
(SELECT IIF(IsNull(Sum(Quantity)),0" & _
",Sum([Quantity])) AS SumOfQuantity FROM tblInventoryTransactions WHERE
(((tblInventoryTransactions.ProductI" & _
"D)=T1.ProductID));) AS OnHandQuantity, (SELECT
IIF(IsNull(Sum([Quantity])),0,Sum([Quantity])) AS SumOfQuant" & _
"ity FROM tblShoppingCarts INNER JOIN tblShoppingCartItems ON
tblShoppingCarts.CartID = tblShoppingCartItems" & _
".CartID WHERE (((tblShoppingCarts.CompletedToPurchase)=True) AND
((tblShoppingCarts.Closed)=False) AND ((tb" & _
"lShoppingCartItems.ProductID)=T1.ProductID));) AS OnHoldQuantity,
[OnHandQuantity]-[OnHoldQuantity] AS AvailableQuantity " & _
"FROM tblProducts AS T1 " & _
"WHERE (((T1.VisibleOnProductsPage)=True) AND (((SELECT
IIF(IsNull(Sum(Quantity)),0,Sum([Quantity])) AS SumOfQuantity FROM
tblInventoryTransactions WHERE
(((tblInventoryTransactions.ProductID)=T1.ProductID));))>0)) " & _
"ORDER BY T1.ProductName;"
rs.Open strSQL, cnn, adOpenKeyset, adLockReadOnly
If rs.EOF = False Then rs.MoveFirst
Do Until rs.EOF = True
    CreateProductToTypeAssociations "ShoppingCartNode",
rs.Fields(0).Value
    rs.MoveNext
Loop
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing

For Each nn In NavNodes
    If nn.ParentID <> 0 Then
        Set nTmp = NavNodes("ID:" & nn.ParentID)
        nTmp.AddChild nn
        Set nTmp = Nothing
    End If
Next
End Function
Private Sub CreateProductToTypeAssociations(TypeID As String, ProductID
As Long)
On Error Resume Next
Dim nn As Node
Set nn = NavNodes(TypeID)
nn.AddChild NavNodes("ProductID:" & ProductID)
Set nn = Nothing
End Sub
Private Sub Class_Initialize()
RetrieveNavigation
End Sub