Dim rs As New ADODB.Recordset
Dim con As New ADODB.Connection
Dim ndx As MSComctlLib.Node
Dim i As Long
On Error GoTo er
con.Open "MS SQL connection"
TV.Nodes.Clear 'TV это тривью
With rs
.Open "select distinct(data_fild) from table", con, adOpenStatic ' запрос вывода основных веток
If .RecordCount >  0  Then
.MoveFirst
Do Until .EOF
   Set ndx = TV.Nodes.Add() ' добавляем основные ветки типа даты
        ndx.Text = .Fields("data_fild").Value
        ndx.Tag = "мама"
    .MoveNext
Loop
End If
.Close
.Open "select distinct(что_то_связаное_с_датой),data_fild from table", con, adOpenStatic 'запрос вывода дочерних веток
If .RecordCount >  0  Then
    For i =  1  To TV.Nodes.Count
    .MoveFirst
        Do Until .EOF
        If TV.Nodes(i).Text = .Fields("data_fild").Value Then 'песли даты в запросе и в дереве совпадают то вводится дочерняя ветка
          Set ndx = TV.Nodes.Add(i, tvwChild) ' добавляем дочерние ветки в папке с основной датой
           ndx.Text = .Fields("что_то_связаное_с_датой").Value
           ndx.Tag = "дочка"
        End If
        .MoveNext
        Loop
    Next i
    
End If
.Close

End With
con.Close
Set rs = Nothing
Set con = Nothing
Set ndx = Nothing

Exit Sub
er:
MsgBox Err.Description
con.Close
Set rs = Nothing
Set con = Nothing
Set ndx = Nothing
Exit Sub

With rs
.Open "select distinct(data) from table", con, adOpenStatic ' 
If .RecordCount >  0  Then
.MoveFirst
Do Until .EOF
   Set ndx = TV.Nodes.Add() 
        ndx.Text = .Fields("data").Value
        ndx.Tag = "ìàìà"
    .MoveNext
Loop
End If
.Close
.Open "select distinct(name),data from table", con, adOpenStatic 
If .RecordCount >  0  Then
    For i =  1  To TV.Nodes.Count
    .MoveFirst
        Do Until .EOF
        If TV.Nodes(i).Text = .Fields("data").Value Then 
          Set ndx = TV.Nodes.Add(i, tvwChild) 
           ndx.Text = .Fields("name").Value
           ndx.Tag = "äî÷êà"
        End If
        .MoveNext
        Loop
    Next i
    
End If
.Close

End With