Навигация по спецификации средствами VBA (Excel)

Private Function PrintSpec(Number As Long, Module As CSDN.DModule, ParentSborka As String)
    Dim J As Integer
    Dim Spec As CSDN.NmkSpecification
    Dim Props2 As CSDN.PropArray
    
    Set Spec = Module.Properties("NmkSpecification").AsIDispatch        'Переходим в спецификацию
    If Spec Is Nothing Then
        J = 0
    End If
    'Создаем массив свойств и заполняем его
    Set Props2 = Spec.CreatePropArray(1)                                
    J = Props2.Add(0, "NMK_ID", 0)                                      
    J = Props2.Add(0, "NMK_NOTE", 0)                                    
    J = Props2.Add(0, "NMK_NAME", 0)                                    
    J = Props2.Add(0, "NMK_CLASSIF_TYPE_NOTE", 0)                       
    J = Props2.Add(0, "QUANTITY", 0)                                    
    'Выводим спецификацию на лист
    Number = PrintDataToSheet(Number, Spec, Props2, ParentSborka)
    Set Props2 = Nothing
    Set Spec = Nothing
    PrintSpec = Number
End Function

Sub Test()
    Dim Golova As Long
    Dim Hvost As Long
    Dim CurrentSborka As String
    Dim NMks As CSDN.Nomenclatures
    Dim Nmk As CSDN.SingleNomenclature
        
    Call Login
    Set NMks = App.Nomenclatures(SB_ID)                                 
    If NMks.RunModuleForSelect("Выберите номенклатуру", True) Then
        'Заполняем шапку таблицы
        ActiveWorkbook.Sheets(1).Cells(1, 1).Value = "ID"
        ActiveWorkbook.Sheets(1).Cells(1, 2).Value = "Децимальный номер"
        ActiveWorkbook.Sheets(1).Cells(1, 3).Value = "Наименование"
        ActiveWorkbook.Sheets(1).Cells(1, 4).Value = "Тип"
        ActiveWorkbook.Sheets(1).Cells(1, 5).Value = "Кол-во"
        ActiveWorkbook.Sheets(1).Cells(1, 6).Value = "Куда входит"
        'Запоминаем децимальный номер главной сборки
        CurrentSborka = NMks.Properties("NOTE").AsString
        'Заносим данные главной сборки
        ActiveWorkbook.Sheets(1).Cells(2, 1).Value = NMks.Properties("ID").AsString
        ActiveWorkbook.Sheets(1).Cells(2, 2).Value = NMks.Properties("NOTE").AsString
        ActiveWorkbook.Sheets(1).Cells(2, 3).Value = NMks.Properties("NAME").AsString
        ActiveWorkbook.Sheets(1).Cells(2, 4).Value = "СБ"
        ActiveWorkbook.Sheets(1).Cells(2, 5).Value = "1"
        Golova = 3                                                      'Установка индекса головы списка
        Hvost = 3                                                       'Установка индекса хвоста списка
        If NMks.GotoSelectedRow(0) Then
            Hvost = PrintSpec(Hvost, NMks, CurrentSborka)               'Выводим главную спецификацию
            Do
                If ((ActiveWorkbook.Sheets(1).Cells(Golova, 4).Value = "СБ") Or (ActiveWorkbook.Sheets(1).Cells(Golova, 4).Value = "КОМПЛЕКТ")) Then
                'Если текущая позиция сборка или комплект
                    Set Nmk = App.SingleNmkFromId(CLng(ActiveWorkbook.Sheets(1).Cells(Golova, 1).Value))
                    Hvost = PrintSpec(Hvost, Nmk, CStr(ActiveWorkbook.Sheets(1).Cells(Golova, 2).Value))
                    Set Nmk = Nothing
                End If
                Golova = Golova + 1                                     'Инкремент головы
            'Выполняем цикл до того момента пока "голова" не настигнет "хвост" - т.е. все записи, 
            'полученные от TCS будут обработаны на признак сборки
            Loop Until Golova = Hvost                                   
        End If
        Set NMks = Nothing
        Set Nmk = Nothing
    End If
End Sub

Set Spec = Module.Properties("NmkSpecification").AsIDispatch

Private Function PrintSpec(Number As Long, Module As CSDN.DModule, ParentSborka As String)
    Const retries As Integer = 5
        
    Dim J As Integer
    Dim t As Integer
    Dim Spec As CSDN.NmkSpecification
    Dim Props2 As CSDN.PropArray
    
    For t = 0 To retries
        Set Spec = Module.Properties("NmkSpecification").AsIDispatch    'Ïåðåõîäèì â ñïåöèôèêàöèþ
        Spec.UserModuleName = "Spec"
        If Not (Spec Is Nothing) Then
            Exit For
        Else
            'Set Spec = Nothing
            App.DeleteModuleByUserModuleName ("Spec")
        End If
    Next t
    'If Spec Is Nothing Then
    '    J = 0
    'End If
    Set Props2 = Spec.CreatePropArray(1)                                'Ñîçäàåì ìàññèâ ñâîéñòâ è çàïîëíÿåì åãî
    J = Props2.Add(0, "NMK_ID", 0)                                      'Èäåíòèôèêàòîð ïîçèöèè â ñïåöèôèêàöèè
    J = Props2.Add(0, "NMK_NOTE", 0)                                    'Äåöèìàëüíûé íîìåð
    J = Props2.Add(0, "NMK_NAME", 0)                                    'Íàèìåíîâàíèå
    J = Props2.Add(0, "NMK_CLASSIF_TYPE_NOTE", 0)                       'Òèï
    J = Props2.Add(0, "QUANTITY", 0)                                    'Êîëè÷åñòâî
    'Âûâîäèì ñïåöèôèêàöèþ íà ëèñò
    Number = PrintDataToSheet(Number, Spec, Props2, ParentSborka)
    'Call App.DeleteModuleByUserModuleName("Spec")
    'Call App.DeleteModuleByUserModuleName("Props2")
    Set Props2 = Nothing
    'Set Spec = Nothing
    App.DeleteModuleByUserModuleName ("Spec")
    PrintSpec = Number
End Function

Sub Test()
    Const retries As Integer = 5
    
    Dim t As Integer
    Dim Golova As Long
    Dim Hvost As Long
    Dim CurrentSborka As String
    Dim NMks As CSDN.Nomenclatures
    Dim Nmk As CSDN.SingleNomenclature
        
    Call Login
    Set NMks = App.Nomenclatures(SB_ID)                                 'Переходим в раздел "СБ" в номенклатуре
    If NMks.RunModuleForSelect("Выберите номенклатуру", True) Then      'Открываем диалог выбора изделия из классификатора
        'Заполняем шапку таблицы
        ActiveWorkbook.Sheets(1).Cells(1, 1).Value = "ID"
        ActiveWorkbook.Sheets(1).Cells(1, 2).Value = "Децимальный номер"
        ActiveWorkbook.Sheets(1).Cells(1, 3).Value = "Наименование"
        ActiveWorkbook.Sheets(1).Cells(1, 4).Value = "Тип"
        ActiveWorkbook.Sheets(1).Cells(1, 5).Value = "Кол-во"
        ActiveWorkbook.Sheets(1).Cells(1, 6).Value = "Куда входит"
        'Запоминаем децимальный номер главной сборки
        CurrentSborka = NMks.Properties("NOTE").AsString
        'Заносим данные главной сборки
        ActiveWorkbook.Sheets(1).Cells(2, 1).Value = NMks.Properties("ID").AsString
        ActiveWorkbook.Sheets(1).Cells(2, 2).Value = NMks.Properties("NOTE").AsString
        ActiveWorkbook.Sheets(1).Cells(2, 3).Value = NMks.Properties("NAME").AsString
        ActiveWorkbook.Sheets(1).Cells(2, 4).Value = "СБ"
        ActiveWorkbook.Sheets(1).Cells(2, 5).Value = "1"
        Golova = 3                                                      'Установка счетчика головы (номер текущей обрабатываемой позиции)
        Hvost = 3                                                       'Установка счетчика хвоста (номер последней добавленной позиции)
        If NMks.GotoSelectedRow(0) Then
            Hvost = PrintSpec(Hvost, NMks, CurrentSborka)               'Выводим главную сборку
            Do
                If ((ActiveWorkbook.Sheets(1).Cells(Golova, 4).Value = "СБ") Or (ActiveWorkbook.Sheets(1).Cells(Golova, 4).Value = "КОМПЛЕКТ")) Then
                'Если текущая позиция сборка или комплект
                    For t = 0 To retries
                        Set Nmk = App.SingleNmkFromId(CLng(ActiveWorkbook.Sheets(1).Cells(Golova, 1).Value))
                        Nmk.UserModuleName = "Nomeklature"
                        If Not (Nmk Is Nothing) Then
                            Exit For
                        Else
                            App.DeleteModuleByUserModuleName ("Nomeklature")
                        End If
                    Next t
                    Hvost = PrintSpec(Hvost, Nmk, CStr(ActiveWorkbook.Sheets(1).Cells(Golova, 2).Value))
                    'Set Nmk = Nothing
                    App.DeleteModuleByUserModuleName ("Nomeklature")
                End If
                Golova = Golova + 1                                     'Инкремент головы
            Loop Until Golova = Hvost                                   'Выполняем цикл до того момента пока "голова" не настигнет "хвост" - т.е. все записи, полученные от TCS будут обработаны на признак сборки
        End If
        Set NMks = Nothing
        Set Nmk = Nothing
    End If
End Sub

Set NMks = App.Nomenclatures2(SB_ID, "TCS_ST_KG")