Attribute VB_Name = "Module_showProperties"
'   showProperties - FrontPage All Files Report
'   Copyright (C) 2002  Stephen C. Travis

'   This program is free software; you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation; either version 2 of the License, or
'   (at your option) any later version.

'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.

'   You should have received a copy of the GNU General Public License
'   along with this program; if not, write to the Free Software
'   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'   or visit their website at http://www.fsf.org/licenses/gpl.txt
'
Dim s
Dim obj_Fields
Dim goDeep
Dim nbSpace
Dim startFolder
Dim StartBlock
Dim StartLine
Dim HeaderStartField
Dim StartField
Dim EndField
Dim HeaderEndField
Dim EndLine
Dim EndBlock
Private Sub selectProperties()
    startFolder = ""  ' example: startFolder = "images"
    goDeep = True     ' process subfolders - True/False
    nbSpace = True    ' add non-breaking space to empty cells - True/False
    StartBlock = vbCrLf & "<table>" & vbCrLf
    StartLine = "<tr>" & vbCrLf
    HeaderStartField = "<th>"
    StartField = "<td>"
    EndField = "</td>"
    HeaderEndField = "</th>"
    EndLine = vbCrLf & "</tr>" & vbCrLf
    EndBlock = "</table>" & vbCrLf
    '
    ' Field Definitions - "ColumnName", "PropertyName"
    ' NOTE: PropertyName can be either a property of the WebFile object or
    ' a vti property. A complete list of vti properties can be found in the
    ' Object Browser Help File under "Properties Collection Object"
    '
    obj_Fields.Add "Name", "Name"
    obj_Fields.Add "Title", "vti_title"
    obj_Fields.Add "In Folder", "URL"
    obj_Fields.Add "Size", "vti_filesize"
    obj_Fields.Add "Type", "Extension"
    obj_Fields.Add "Modified Date", "vti_timelastmodified"
    obj_Fields.Add "Modified By", "vti_author"
    obj_Fields.Add "Comments", "vti_description"
    'obj_Fields.Add "CheckedOutBy", "CheckedOutBy"
    'obj_Fields.Add "AssignedTo", "vti_assignedto"
    'obj_Fields.Add "Status", "vti_approvallevel"
    '
    ' End Field Definitions
    '
End Sub
Sub showProperties()
    On Error Resume Next
    Dim myStartFolder As WebFolder
    Dim myRange As IHTMLTxtRange
    If Not FrontPage.ActiveWeb Is Nothing Then
    If Not FrontPage.ActiveDocument Is Nothing Then
    If FrontPage.ActivePageWindow.ViewMode = fpPageViewNormal Then
        Set obj_Fields = CreateObject("Scripting.Dictionary")
        Call selectProperties
        s = StartBlock
        s = s & StartLine
        For Each Field In obj_Fields
            s = s & HeaderStartField & Field & HeaderEndField
        Next
        s = s & EndLine
        If startFolder = "" Then
            Set myStartFolder = ActiveWeb.RootFolder
        Else
            Set myStartFolder = ActiveWeb.RootFolder.Folders(startFolder)
        End If
        If Err <> 0 Then
            MsgBox ("The start folder does not exist.")
            Exit Sub
        End If
        WalkTree myStartFolder
        s = s & EndBlock
        Set myRange = ActiveDocument.selection.createRange
        myRange.collapse
        myRange.pasteHTML (s)
    End If
    End If
    End If
End Sub
Private Sub WalkTree(myWebFolder As WebFolder)
    On Error Resume Next
    Dim mySubFolder As WebFolder
    Dim myFiles As WebFiles
    Dim myFile As WebFile
    Set myFiles = myWebFolder.Files
    For Each myFile In myFiles
        s = s & StartLine
        For Each Field In obj_Fields
            strField = ""
            s = s & StartField
            strFieldName = obj_Fields.Item(Field)
            If Left(strFieldName, 4) = "vti_" Then
                strField = myFile.Properties(strFieldName)
            ElseIf strFieldName = "URL" Then
                strRoot = CallByName(ActiveWeb.RootFolder, "Url", VbGet)
                strParent = CallByName(myFile.Parent, "Url", VbGet)
                strField = MakeRel(strRoot, strParent)
            Else
                strField = CallByName(myFile, strFieldName, VbGet)
            End If
            If strField = "" And nbSpace Then strField = "&nbsp;"
            s = s & strField
            s = s & EndField
        Next
        s = s & EndLine
    Next myFile
    If Not goDeep Then Exit Sub
    For Each mySubFolder In myWebFolder.Folders
            WalkTree mySubFolder
    Next mySubFolder
End Sub