ПОдробнее плиз.
"При добавлении нового элемента" - куда как ?
Заполнение этого столбца в листвию добавили?

как Вы заполняете листвью? Точно листвью, а не листбокс?

Private Sub Form_Load()

Dim sNodeSelected As String
Dim ND As Object

Set NodeRS = CurrentDb.OpenRecordset("SP-1", dbOpenDynaset)


Set TV = Me![SpView]

If Nz(Me.OpenArgs, "") <> "" Then ' strOpArg = lFirm & ":" & lDoc & ":" & sKey
strOpArg = Me.OpenArgs
End If

varReturn = SysCmd(acSysCmdSetStatus, "Подождите ...")
DoCmd.Hourglass True

Call FillTvw(Me.tvwClassifStr, "", "", "Структура", "IDCODE", "Name", "", 0, 0)

'необходимо спозиционироваться на эту строку
TV_ВыделитьУзел Me.tvwClassifStr, sNodeSelected & "ID"
Me.tvwClassifStr.SetFocus

idParent = "0100000000"
GetSpisok ND, idParent

varReturn = SysCmd(acSysCmdSetStatus, "Дирекция филиала")
DoCmd.Hourglass False

Позавчера повесили программу на меня и уже поставили сроки(((( А ВБА мне не друг!

Посмотрите может это оно.

'это для структуры - ключ- строка....
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


Вот она!

Отправил на мыло