ник: Fan_MC
'это для структуры - ключ- строка....
Public Function FillTvw(tvwObj As Object, _
sKey As String, _
sMainParentKey As String, _
sTblName As String, _
sFldName As String, _
sFldTxtName As String, _
sFldDocName As String, _
IDDOc As Long, lFirm As Long) As Boolean
Dim txt As String
Dim rs As Recordset
'Dim db As Database
Dim lintParentIdx As Long
Dim mNode As Object
Dim sLastKey As String
Set db = CurrentDb
If sKey = "" Then
End If
'txt = "SELECT * FROM " & sTblName & " WHERE (" & sFldName & " Like '" & sKey & "*') AND " & sFldDocName & " = " & IDDOc & " AND " & lGlFirm & " = " & lFirm & " ORDER BY " & sFldName & ";"
txt = "SELECT * FROM " & sTblName & " WHERE (" & sFldName & " Like '" & sKey & "*')" & " ORDER BY " & sFldName & ";"
Set rs = db.OpenRecordset(txt)
Do Until rs.EOF
If Len(rs(sFldName)) = Len(sKey) Or Len(rs(sFldName)) = sKeyLen Then
'создаем ветку в дереве
'TV_ДобавитьУзел
If sLastKey = "" Then '(не было создано ни одного на этом уровне)
tvwAddNode tvwObj, rs(sFldName) & "ID", rs(sFldTxtName), , IIf(sMainParentKey = "", "", sMainParentKey & "ID"), tvwChild, 2, 3 '"closed", "open"
Else
tvwAddNode tvwObj, rs(sFldName) & "ID", rs(sFldTxtName), , sLastKey & "ID", 2, 2, 3 '"closed", "open"
End If
sLastKey = rs(sFldName)
DoEvents 'без этих извращений с sLastKey не сортируется верхний уровень.. :(
Else
'реккурентно вызываем опять эту же функцию...
'но только если она дочерняя к sKey...
If Len(rs(sFldName)) = Len(sLastKey) + sKeyLen Then
Call FillTvw(tvwObj, rs(sFldName), sLastKey, sTblName, sFldName, sFldTxtName, sFldDocName, IDDOc, lFirm)
End If
End If
rs.MoveNext
Loop
End Function
Вот она!