Option Explicit
' Frontpage VBA Macro to create a ASP Sitemap-File
' (c) 2007 Frank Carius  http://www.msxfaq.de
' More information see ASP.NE Sitemaps
' http://msdn2.microsoft.com/de-de/library/yy2ykkab(VS.80).aspx
'
' URL-Attribut can start with "~/" beginnen, to start from the application root folder

Sub ASPSiteMap()

    Const aspsitemapfile As String = "web.sitemap"     ' name of the sitemapfile
    
    If ActiveWeb Is Nothing Then
        MsgBox "Please open Web first.", vbOKOnly Or vbCritical
        Exit Sub
    End If
    
    Debug.Print "BuildASPSitemap: started"
    
    Dim XMLDomSiteMap As MSXML2.DOMDocument
    Set XMLDomSiteMap = New MSXML2.DOMDocument
    
    Dim XMLCurrentNode As MSXML2.IXMLDOMNode
    Set XMLCurrentNode = XMLDomSiteMap
    XMLDomSiteMap.LoadXML "<?xml version='1.0' encoding='utf-8'?>"
    
    ' Create the Root node
    Dim XMLNewNode As MSXML2.IXMLDOMNode
    Set XMLNewNode = XMLDomSiteMap.createElement("siteMap")
    XMLCurrentNode.appendChild XMLNewNode
    Set XMLCurrentNode = XMLNewNode
    
    ' recurse processing of the sitemap
    Call RecursiveAddNodes(XMLCurrentNode, ActiveWeb.RootNavigationNode.Children(0))

    Set XMLCurrentNode = XMLCurrentNode.ParentNode
    XMLDomSiteMap.Save (ActiveWeb.RootFolder & "/" & aspsitemapfile)

    Debug.Print "Done, Written to:" & ActiveWeb.RootFolder & "/" & aspsitemapfile

End Sub

Sub RecursiveAddNodes(ByRef XMLCurrentNode As MSXML2.IXMLDOMNode, ByRef currentpage As NavigationNode)
    
    Debug.Print " Processing:" & currentpage.Label & " - " & MakeRel(ActiveWeb.URL & "/", currentpage.URL)
    '  Add current page to Sitemap XML
    Call AddSiteNode(XMLCurrentNode, currentpage)
      
    ' Process subnodes
    Dim subnode As NavigationNode
    für Each subnode In currentpage.Children
        If subnode.InNavBars = True Then
            Call RecursiveAddNodes(XMLCurrentNode, subnode)
        End If
    Next
    ' Close the current Tag
    Set XMLCurrentNode = XMLCurrentNode.ParentNode
    
End Sub


Sub AddSiteNode(ByRef XMLCurrentNode As MSXML2.IXMLDOMNode, ByRef currentpage As NavigationNode)
    ' Append Sitemap Node and move to current node
    Dim TempXMLNode, XMLDomObject
    Set XMLDomObject = New MSXML2.DOMDocument
    Set TempXMLNode = XMLDomObject.createElement("siteMapNode")
    TempXMLNode.setAttribute "URL", "~/" & MakeRel(ActiveWeb.URL & "/", currentpage.URL)
    TempXMLNode.setAttribute "title", currentpage.Label
    TempXMLNode.setAttribute "description", currentpage.Label
    XMLCurrentNode.appendChild TempXMLNode
    Set XMLCurrentNode = TempXMLNode
End Sub