Node.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  ' True
END
Attribute VB_Name = "Node"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
 
Dim m_Name As String
Dim m_Parent As Node
Dim m_Children As New Collection
 
Property Get Name() As String
    Name = m_Name
End Property
 
Property Let Name(val As String)
    m_Name = val
End Property
 
Property Get Parent() As Node
    Set Parent = m_Parent
End Property
 
Property Set Parent(n As Node)
    Set m_Parent = n
End Property
 
Property Get Children(i As Long) As Node
    Attribute Children.VB_UserMemId = 0
    Set Children = m_Children(i) ' Collection Class is Base 1
End Property
 
Property Get ChildCount() As Long
    ChildCount = m_Children.Count
End Property
 
Public Function NewEnum() As IUnknown ' or IEnumVARIANT
    Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = m_Children.[_NewEnum]
End Function
 
Property Get Path() As String
    If m_Parent Is Nothing Then
        Path = m_Name
    Else
        Path = m_Parent.Path & "\" & m_Name
    End If
End Property
 
Public Function Add(val As String) As Node
    Set Add = New Node
    Add.Name = val
    AddNode Add
End Function
 
Public Sub AddNode(n As Node)
    If n Is Nothing Then
        Exit Sub
    End If
    
    Set n.Parent = Me
    m_Children.Add n
End Sub
 
Public Function Remove(val As String) As Boolean
    Dim n As Node
    For Each n In m_Children
        If n.Name = val Then
            m_Children.Remove n
            Remove = True
            Exit Function
        End If
    Next
    
    Remove = False
End Function
 
Public Function Clone() As Node
    Set Clone = New Node
    Clone.Name = m_Name
    
    Dim n As Node
    For Each n In m_Children
        Clone.AddNode n.Clone
    Next
End Function

• 標準モジュール

Sub test()
    Dim n(5) As Node
    Set n(0) = New Node
    n(0).Name = "C:"
    Set n(1) = n(0).Add("Documents and Settings")
    Set n(2) = n(1).Add("Administrator")
    Set n(3) = n(2).Add("Cookies")
    Set n(4) = n(2).Add("Local Settings")
    Set n(5) = n(4).Add("Temp")
 
'    Dim i As Long
'    For i = LBound(n) To UBound(n)
'        Debug.Print n(i).Path
'    Next
    
'   DebugPrint1 n(0)
'   DebugPrint2 n(0)
    
    Dim c As Node
    Set c = n(1).Clone
    n(2).Name = "hoge"
    DebugPrint1 n(0)
    DebugPrint1 c
End Sub
 
Sub DebugPrint1(p As Node)
    Debug.Print p.Path
    Dim i As Long
    For i = 1 To p.ChildCount
        DebugPrint1 p.Children(i)
    Next
End Sub
 
Sub DebugPrint2(p As Variant) ' TypeName(p) = Node
    Debug.Print p.Path
    Dim c As Variant
    For Each c In p
        DebugPrint2 c
    Next
End Sub

cf.Creating Your Own Collection Classes
http://msdn.microsoft.com/ja-jp/library/aa262340