Колекция ответных док-ов

[KIL]

Есть три формы представляющие сабой иерархию, первая типа "Document", вторая и третья "ответ на ответ". Задача получить все нижестоящие документы которые являются ответными на выбранный (может быть ответным). Подскажи Как?

 

[Hedg]

Как связан основной документ с ответом??

 

[Kee_Keekkenen]

так как это написал KILL это responce связь..

если это так, то вот частный пример, в котором вычисляется количество всех документов ответов
переделать и обобщить его под свои нужды, я думаю, не составит большой трудности

Sub Click(Source As Button)
Dim ses As New NotesSession
Dim db As NotesDatabase

Dim sourceColl As NotesDocumentCollection, firstRespColl As NotesDocumentCollection, secondRespColl As NotesDocumentCollection
Dim sourceDoc As NotesDocument, firstRespDoc As NotesDocument
Dim respCount As Long

Set db = ses.CurrentDatabase
Set sourceColl = db.AllDocuments
If sourceColl.Count = 0 Then Exit Sub
Set sourceDoc = sourceColl.GetFirstDocument

While Not (sourceDoc Is Nothing)
If Not(sourceDoc.IsResponse) Then

Set firstRespColl = sourceDoc.Responses
If firstRespColl.Count > 0 Then
respCount = respCount + firstRespColl.Count

Set firstRespDoc = firstRespColl.GetFirstDocument

While Not(firstRespDoc Is Nothing)
Set secondRespColl = firstRespDoc.Responses
If secondRespColl.Count > 0 Then
respCount = respCount + secondRespColl.Count
End If
Set firstRespDoc = firstRespColl.GetNextDocument(firstRespDoc)
Wend

End If

End If

Set sourceDoc = sourceColl.GetNextDocument(sourceDoc)
Wend

Msgbox "Всего количество ответных документов " + Cstr(respCount)

End Sub

 

[Elena Nefedova]

<!--QuoteBegin-KIL+23:06:2007, 13:58 -->
<span class="vbquote">(KIL @ 23:06:2007, 13:58 )</span><!--QuoteEBegin-->Задача получить все нижестоящие документы которые являются ответными на выбранный

[snapback]70387" rel="nofollow" target="_blank[/snapback]​

[/quote]
Вот так можно кодом.

Function all_desc(root As notesDocument, b_error As Boolean) As NotesdocumentCollection
On Error Goto ErrLab
Dim col As NotesDocumentCollection
Dim children As NotesdocumentCollection
Dim doc As Notesdocument, push As NotesDocument
Dim k%, m%
Set children = root.Responses
If Not (children Is Nothing) Then
Set doc = children.getFirstDocument
Do Until doc Is Nothing
If Not doc.IsDeleted And doc.IsValid Then
Set col = all_desc(doc, b_error)
If Not (col Is Nothing) Then
Set push = col.GetFirstDocument
Do Until push Is Nothing
If Not push.IsDeleted And push.IsValid Then
On Error 4469 Resume Next
Call children.AddDocument(push)
On Error Goto ErrLab
End If
Set push = col.getNextDocument(push)
Loop
End If
End If
Set doc = children.getNextDocument(doc)
Loop
End If
Set all_desc = children
Exit Function
ErrLab:
b_error = True
Msgbox "Error " + Cstr(Err) + " at line " + Cstr(Erl)
Exit Function
End Function

А если во встроенной вьюшке надо светить, то используем флаг Show only current thread