Option Explicit
 
Private Sub Form_Load()
 
  Dim i       As Long
  Dim ii      As Long
  Dim iii     As Long
 
  ' TreeView mit TestNodes füllen
  ' Als Key verwenden wir immer den FullPath des Parent
  ' zusammen mit dem Text des Nodes (Dadurch sollte es eindeutig
  ' werden)
  Dim oNode As MSComctlLib.Node
  Dim oNode1 As MSComctlLib.Node
 
  With Me.TreeView1
    For i = 1 To 5
      Set oNode = Me.TreeView1.Nodes.Add(, , "MainNode_" & i, "MainNode_" & i)
      For ii = 1 To 10
        Set oNode1 = AddNode("Child_" & i & "_" & ii, oNode, , , "EinfachSo")
        For iii = 1 To 5
          AddNode "Child_" & i & "_" & ii & "_" & iii, oNode1, , , "Tag" & _
            "Level3_" & iii
        Next iii
      Next ii
    Next i
 
    .OLEDragMode = ccOLEDragAutomatic
    .OLEDropMode = ccOLEDropManual
  End With
End Sub
 
Private Sub Form_Resize()
  TreeView1.Height = Me.ScaleHeight - 60
End Sub
 
Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, _
    x As Single, y As Single)
  ' Da das OLEStartDrag Ereignis vor dem NodeClick ereignis
  ' augeführt wird, müssen wir sicherstellen, das auch wirklich
  ' das richtige Node selektiert ist.
  Me.TreeView1.SelectedItem = Me.TreeView1.HitTest(x, y)
End Sub
 
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
  Debug.Print Node.Key
  Debug.Print Node.FullPath
End Sub
 
Private Function AddNode(sText As String, oParent As MSComctlLib.Node, _
        Optional Image, Optional SelectedImage, Optional sTag As String) As _
        MSComctlLib.Node
  Dim sKey      As String
 
  sKey = oParent.FullPath & "" & sText
  Set AddNode = Me.TreeView1.Nodes.Add(oParent.FullPath, tvwChild, sKey, _
                    sText, Image, SelectedImage)
  If sTag <> "" Then
    AddNode.Tag = sTag
  End If
 
End Function
 
Private Function KopyNode(oSourceNode As MSComctlLib.Node, oToParent As _
  MSComctlLib.Node)
 
  Dim i                 As Long
  Dim oChildNode        As MSComctlLib.Node
 
  Call AddNode(oSourceNode.Text, oToParent, , , oSourceNode.Tag)
 
  If oSourceNode.Children > 0 Then
    ' Wenn das zu kopierende Node noch Childs hat,
    ' dann diese funktion rekursiv aufrufen
    Set oChildNode = oSourceNode.Child
    For i = 0 To oSourceNode.Children - 1
      Call KopyNode(oChildNode, oSourceNode)
      Set oChildNode = oChildNode.Next
    Next i
  End If
End Function
 
Private Sub TreeView1_OLEDragDrop(Data As MSComctlLib.DataObject, _
    Effect As Long, Button As Integer, Shift As Integer, _
    x As Single, y As Single)
  Dim sTemp     As String
  Dim oNode     As MSComctlLib.Node
  Dim oDragNode As MSComctlLib.Node
 
  Set oNode = Me.TreeView1.HitTest(x, y)
 
  If Data.GetFormat(vbCFText) Then
    sTemp = Data.GetData(vbCFText)
    Set oDragNode = TreeView1.Nodes(sTemp)
    Select Case Shift
      Case 0
        ' Kein Schift also Move
        ' ok nun schaun wir mal wo das Node denn Hin soll
        If oNode.Parent Is Nothing Or oNode.Children > 0 Then
          ' Wenn über einem Root Node gedroppt wurde,
          ' das Drop Node einfach in dieses RootNode hängen
          Set oDragNode.Parent = oNode
        Else
          ' ansonsten in den Parent des Nodes
          Set oDragNode.Parent = oNode.Parent
        End If
        Set TreeView1.DropHighlight = Nothing
      Case 2
        ' Schift gedrückt also Copy
        ' ok nun schaun wir mal wo das Node denn Hin soll
        If oNode.Parent Is Nothing Or oNode.Children > 0 Then
          ' Wenn über einem Root Node gedroppt wurde,
          ' das Drop Node einfach in dieses RootNode hängen
          Set oDragNode.Parent = oNode
          Call KopyNode(oDragNode, oNode)
        Else
          ' ansonsten
          Call KopyNode(oDragNode, oNode.Parent)
        End If
        Set TreeView1.DropHighlight = Nothing
    End Select
  End If
End Sub
 
Private Sub TreeView1_OLEDragOver(Data As MSComctlLib.DataObject, _
    Effect As Long, Button As Integer, Shift As Integer, _
    x As Single, y As Single, State As Integer)
   With TreeView1
     If State = vbLeave Then
       ' Wenn wir das TreeView verlassen, auch das Highlight
       ' entfernen
       Set .DropHighlight = Nothing
     Else
       .DropHighlight = .HitTest(x, y)
      End If
   End With
End Sub
 
Private Sub TreeView1_OLEStartDrag(Data As MSComctlLib.DataObject, _
  AllowedEffects As Long)
 
  Dim oDragNode As MSComctlLib.Node
 
  Data.Clear
  ' Nicht für Root Nodes geeignet
  If Not Me.TreeView1.SelectedItem.Parent Is Nothing Then
    Data.SetData Me.TreeView1.SelectedItem.Key, vbCFText
  End If
 
End Sub