Public Function FUN_TO_CHILDREN(STR_NUMBER_CARD As String) As Integer ' применим Find для открытого рекордсета '(параметры уточнить там  даже есть направление поиска) Dim rst As ADODB.Recordset Dim Id_ As String Dim Id_Go As String Set rst = New ADODB.Recordset Id_ = STR_NUMBER_CARD & "," ' это строка в ней содержатся закладки для перехода - в конце зпт чтоб не морочить голову на проверку когда остается только родитель GLB_GROUP_TURN = 0 ' или что нужно rst.Open "CLIENT_CARDS_TBL", GLB_CONNECTION, adOpenKeyset, adLockOptimistic 'FUN_TO_CHILDREN (STR_NUMBER_CARD) rst.Find "PARENT_CARD = '" & STR_NUMBER_CARD & "'" ' пошли по детям Do While rst.EOF = False ' сделали свое нужное   GLB_VAL_COUNT = GLB_VAL_COUNT + 1     GLB_GROUP_TURN = GLB_GROUP_TURN + (rst("GROUP_ACCOUNT"))     STR_NUMBER_CARD = rst("NUMBER_CARD") '    If GLB_VAL_COUNT >= 2000 Then Exit Do   Debug.Print GLB_VAL_COUNT 'rst("NUMBER_CARD") & "  " & FUN_PERSONAL_TURN(rst("NUMBER_CARD")) ' добавили закладку дитяти     Id_ = rst.Bookmark & "," & Id_ ' запустили с ним функцию 'rst.Close 'Set rst = Nothing     FUN_TO_CHILDREN (STR_NUMBER_CARD) ' по завершении ф-ции перешли на позицию дитяти с где был останов     rst.Bookmark = Val(Mid(Id_, 1, InStr(Id_, ",") - 1)) ' удалили ID дитяти который уже найден для этого папика     Id_ = Mid(Id_, InStr(Id_, ",") + 1) ' получаем ID папика для которого нужно искать дальше     Id_Go = Mid(Id_, 1, InStr(Id_, ",") - 1)     rst.Find "CLIENT_CARDS_TBL.ID= '" & Id_Go & "'" Loop End Function

где то после 200 цикла мы стопоримся и выдаём - что слишком дофига наоткрывали рекордсетов........

не наверное, а точно! :) bd можно передавать в качестве параметра
мало того, вложенность рекурсий тоже ограничена :)

мало того, вложенность рекурсий тоже ограничена :)

Вы мну пугаете - Силыч.

Как же мне пройтись по всем веткам дерева и собрать информацию о каждом фрукте - не напрягая дерева???
закладок - зарубок не напасёшся........

Помогите с продвижением

Блин. Вот открыл я его. Нажал кнопарь. Он выдал что всего карт 6 и далее ошибка. В поле ничего нет. Все. Каких карт? Игра в карты что ли? Чего должно быть-то.

Маркс_11:30:06_124.3095_26.12.2009__Петров Вася

2. Какое-то "необычное" значение PK, да с длиной поля 250.

Ой, да там все текстовые по 250, даже DATE_OF_BIRTH и PASPORT_SERIES.

вот запрос попроще

Блин. Чую себя дебилом среди профессоров. Но если даже Лукас не понял, то я пас.
Пойду за елочкой.

'Описываем массив для хранения закладок. Dim varRecord() As Variant Private Sub Кнопка0_Click() Dim STR_NUMBER_CARD As String ' начнём с первой карты STR_NUMBER_CARD = "1" Set rst_Card = New ADODB.Recordset ' откроем все карты rst_Card.Open "SELECT CLIENT_CARDS_TBL.NUMBER_CARD, CLIENT_CARDS_TBL.PARENT_CARD, CLIENT_CARDS_TBL.GROUP_ACCOUNT  FROM CLIENT_CARDS_TBL ORDER BY NUMBER_CARD DESC", CurrentProject.Connection, adOpenKeyset, adLockOptimistic ' Изменяем верхнюю границу размерности массива до значения свойства RecordCount. ReDim varRecord(0 To rst_Card.RecordCount - 1) 'все карты MsgBox " Всего карт" & rst_Card.RecordCount - 1 ' начнём подсчёты FUN_TO_CHILDREN (STR_NUMBER_CARD) ' пойдём с первой карты End Sub Public Function FUN_TO_CHILDREN(STR_NUMBER_CARD As String) As Integer FUN_CHILDREN (STR_NUMBER_CARD) End Function Public Function FUN_CHILDREN(STR_NUMBER_CARD As String) As Integer Dim intI As Long ' счётчик массива intI = 0 ' счётчик массива ' применим Find для открытого рекордсета (параметры уточнить там  даже есть направление поиска) 'отфильтруем детей rst_Card.Filter = "PARENT_CARD = '" & STR_NUMBER_CARD & "'" Debug.Print rst_Card.RecordCount & "  Дитя " ' пошли по детям  If rst_Card.RecordCount <> 0 Then     Do While rst_Card.EOF = False     ' сделали свое нужное         GLB_GROUP_TURN = GLB_GROUP_TURN + rst_Card("GROUP_ACCOUNT")      ' присвоили переменной новое значение номера карты         STR_NUMBER_CARD = rst_Card("NUMBER_CARD") ' (rst("GROUP_ACCOUNT"))         Debug.Print "  Дитё " & rst_Card("NUMBER_CARD")             ' пополняем массив закладками.         varRecord(intI) = rst_Card.Bookmark ' добавили закладку дитяти         ' Увеличивает счетчик.         intI = intI + 1     ' запустили с ним функцию         FUN_TO_CHILDREN (STR_NUMBER_CARD)     Loop Else ' что делать если детей больше нет.........????     ' отключим фильтр        ' rst_Card.Filter = adFilterNone        ' intI = intI - 1       '  Id_Go = varRecord(0)        ' rst_Card.Bookmark = Id_Go    End If End Function     Loop

А чем тебе SQL не угодил?
простой запрос

SELECT * FROM CLIENT_CARDS_TBL WHERE ID_CARDS LIKE 'Код папочки%';

по моему решает твою проблему

НЕТ это ты меня не понял.

привожу пример для ветки
Маркс_12:45:38_116.3475_

SELECT Sum(CLIENT_CARDS_TBL.MONTH_TURN) AS [Sum-MONTH_TURN] FROM CLIENT_CARDS_TBL WHERE (((IIf(Mid$([ID_CARDS],1,Len("Маркс_12:45:38_116.3475_"))="Маркс_12:45:38_116.3475_" And Len([ID_CARDS])>Len("Маркс_12:45:38_116.3475_"),1,0))=1));

это пример не включает ветку, от которой ищем

сделай запрос - вставь код и замени на другую ветку - поймешь

автор: Lukas (18.12.2009 в 19:02) Кстати: Если в запросе добавить поле суммы, то вместо собирания строки ключей, можно просто считать суммы...

Вот интересно, я это для кого писал 9 дней назад?
Для Деда Мороза?
Так ему это и нафик не нужно!

Всего то делов - заточить мой пример под свою задачу:

Public Function AmountWithChildren(IDItem As String, Optional rst As ADODB.Recordset) As Currency     Dim varBmk As Variant     If rst Is Nothing Then         Set rst = New ADODB.Recordset         rst.Open "SELECT NUMBER_CARD, PARENT_CARD, MONTH_TURN FROM CLIENT_CARDS_TBL ORDER BY NUMBER_CARD", CurrentProject.Connection, adOpenKeyset, adLockOptimistic         rst.Find "NUMBER_CARD='" & IDItem & "'"             If Not rst.EOF And Not rst.BOF Then                 AmountWithChildren = rst.Collect(2) + AmountWithChildren(rst.Collect(0), rst)             End If         rst.Close         Set rst = Nothing     Else         rst.MoveFirst         Do Until rst.EOF             rst.Find "PARENT_CARD='" & IDItem & "'"             If Not rst.EOF And Not rst.BOF Then                 varBmk = rst.Bookmark                 AmountWithChildren = AmountWithChildren + rst.Collect(2) + AmountWithChildren(rst.Collect(0), rst)                 rst.Bookmark = varBmk                 rst.MoveNext             End If         Loop     End If End Function

Огромное спасибо Lukas ,
но попробуй задать карточке №1 родителя 1
зациклив рекурсию - её надолго не хватит.......
она переполнит стэк вызовов и остановится.........

Когда только начинал строить своё приложение с использованием дерева, то тоже ввёл вспомогательную таблицу только для некоторых типов элементов, т.е. таблица должна была бы быть меньше, чем если бы она велась для всех элементов. Какое-то время даже радовался ускорению некоторых запросов. Но потом мне надоело поддерживать эту таблицу: при мало-мальском изменении через какое-то время я уже про неё забывал, и сталкивался с ошибками. Хорошо, что веду типа дневника разработки, где пишу что и когда я решил изменить... Да и мои данные предполагают на начальном этапе довольно динамичное перемещение по иерархии (даже пачками), которое при наличие вспомогательной таблицы оказалось затратным для обновления двух таблиц (хотя, может быть, надо было поработать над эффективностью обновления данных...). В общем, я отказался от вспомогательной таблицы.

у мну в мозгу такая вещь крутится -
нужно идя по дереву заносить данные в таблицу обо всех местах, где побывали
и проходя вновь как то добавлять новых и новых, а по оеончании формирования таблицы запросом взять необходимые данные.
только никак не сформируется код, который будет выполнять данную задачу....

перед новым использованием очищать таблицу от данных
и заполнять поновой идя от первого заданного номера карты."вниз" по дереву по веткам.........

тока пока не знаю как запросами создавать такую таблицу записями , которых ещё нет.....

Ясно что создаваемая таблица будет содержать поля как в описаной вспомогателной таблице в вордрвском документе, но вот реализация стопориться моим мозгом......

Отдельная таблица - не надо. Можно просто использовать "отвязанный" набор записей (ADO).
Реализация... да мой мозг тоже тормозит уже третью неделю (холода, наверное, сказываются).

положите сюда пример таких таблиц -я полюбопытствую.........

связь по полю???

Ааа.
У меня ругнулся после 20000 вызова. (я выводил через 100 в дебагер).
Думаешь такого количества рассчитываемых деток будет недостаточно?

Ты знаешь..... я другим способом попробовал - вот посмотри....

Блиннннн - точно!
Надо попробовать создавать такую вспомогалку по мере необходимости - только вот пока не знаю как......
Кстати вот добрый человек ССЫлочку дал

http://am.rusimport.ru/MSAccess/topic.aspx?ID=321

Спасибо - изучаю ...........

==========================
прекрасный пример, чудесный, ....
НОВОГОДНИЙ подарок блин.........
Как раз то , что..........
Это вот прямо оно, с доп таблой для хранения временного значения


Ну ты прям Котттт

Конечно в коде ещё разобраться
, но сам фактттттттттт

Дааааааа

пока тока вот это не понял
как
удалили всех перебранных (остались неперебранные новые детки)

Понятно!!!!!
СЛУХАЙ
а этот счётчик он не переполнится???????
может кажный раз программно создавать новую таблу со счётчиком с 1

вот нарыл (пример табла tmp_naimen, счетчик - Kod, был счетчик - 7 358 255, стал - 1)

Public Function Clear_Count() Dim dbs As DAO.Database Dim op As DAO.Recordset Set dbs = CurrentDb Str_ = "alter table tmp_naimen alter column Kod counter(1,1)" dbs.Execute ("delete * from tmp_naimen") dbs.Execute (Str_) End Function

counter(1000,1) - выставляет счетчик в 1000, че знач второй параметр -

п.с. работает только начиная с 2000-го на ХР прокатило, ну да это ж 2002, а 2002>2000