Поговорим об MS Script Control

[Gustav]

Уважаемые коллеги,

Обнаружен очередной весьма шустрый способ вываливания больших массивов данных из Аксапты в Excel. По предварительным оценкам он в полтора-два раза быстрее способа экспорта из темы Поговорим об ADO, при том, что и ADODB.Recordset, и Range.CopyFromRecordset в нем также присутствуют. Присутствует в нём еще одна штуковина, благодаря которой и достигаются лучшие характеристики.

Знакомьтесь, кто еще не в курсе - COM-сервер Microsoft Srcipt Control. Средство, хотя и существующее в природе с конца прошлого века, но на АксФоруме почему-то до сих пор не обыгранное. На момент написания этих строк я нашёл по строке "msscriptcontrol" буквально пару тем, одна из которых даже с моим участием, где Script Control упоминается мимоходом-мимолетом: Парсер арифметических выражений и Можно ли задать критерий поиска по форуму в строке адреса web-страницы? Настоящей же темой предлагаю воздать должное этому ActiveX'у.

Джоб ниже наследует традиции тем Axapta программирует Excel на VBA и Поговорим об ADO и выполняет тестовое задание темы Исследование скорости экспорта данных из Axapta в Excel (коллективный эксперимент) (чтобы было с чем сравнивать, у меня полное время выполнения составило около 40 секунд):

static void Job_Test_MSScriptControl(Args _args)
{
    LedgerTrans ledgerTrans;
    LedgerTable ledgerTable;

    COM         sc;
    str         vbCode;
    int         row;
    int         timeStart = timenow();
    str         stmt2exec;
    ;

    vbCode =
    'Option Explicit                                                       \r\n' +

    'Public rst                                                            \r\n' +
    'Public fieldList                                                      \r\n' +

    'Sub beforeLoop()                                                      \r\n' +
    '    Set rst = CreateObject("ADODB.Recordset")                         \r\n' +
    '    rst.Fields.Append "F1", 3          \r\n' +  // 3 = adInteger
    '    rst.Fields.Append "F2", 200, 30    \r\n' +  // 200 = adVarChar
    '    rst.Fields.Append "F3", 200, 100   \r\n' +
    '    rst.Fields.Append "F4", 200, 100   \r\n' +
    '    rst.Fields.Append "F5", 3          \r\n' +
    '    rst.Fields.Append "F6", 200, 30    \r\n' +
    '    rst.Fields.Append "F7", 133        \r\n' +  // 133 = adDBDate
    '    rst.Fields.Append "F8", 200, 150   \r\n' +
    '    rst.Fields.Append "F9", 6          \r\n' +  // 6 = adCurrency
    '    rst.Fields.Append "F10",200, 10    \r\n' +
    '    rst.Open                                                          \r\n' +
    '    fieldList = Array(0,1,2,3,4,5,6,7,8,9)                            \r\n' +
    'End Sub                                                               \r\n' +

    'Sub duringLoop(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10)                        \r\n' +
    '    rst.AddNew fieldList, Array(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10)       \r\n' +
    'End Sub                                                               \r\n' +

    'Sub afterLoop()                                                       \r\n' +
    '    Dim xlApp                                                         \r\n' +
    '    Dim headers, rngHeaders                                           \r\n' +
    '    rst.Update                                                        \r\n' +
    '    Set xlApp = CreateObject("Excel.Application")                     \r\n' +
    '    xlApp.Workbooks.Add.Application.Range("A2").CopyFromRecordset rst \r\n' +
    '    headers = Array("RecId", "AccountNum", "AccountName", _           \r\n' +
    '                    "AccountPlType", "BondBatchTrans_RU", _           \r\n' +
    '                    "BondBatch_RU", "TransDate", "Txt", _             \r\n' +
    '                    "AmountMST", "Crediting")                         \r\n' +
    '    Set rngHeaders = xlApp.Range(xlApp.Cells(1, 1), _                 \r\n' +
    '                                 xlApp.Cells(1, UBound(headers) + 1)) \r\n' +
    '    With rngHeaders                                                   \r\n' +
    '       .Value = headers                                               \r\n' +
    '       .Font.Bold = True                                              \r\n' +
    '       .EntireColumn.AutoFit                                          \r\n' +
    '    End With                                                          \r\n' +
    '    xlApp.Visible = True                                              \r\n' +
    'End Sub                                                                   '
    ;

    sc = new COM('MSScriptControl.ScriptControl');
    sc.Language('vbscript');

    sc.AddCode( vbCode );
    sc.ExecuteStatement('beforeLoop');

    row = 0;
    while select  ledgerTrans
            join  ledgerTable
            where ledgerTrans.AccountNum == ledgerTable.AccountNum
               && ledgerTrans.TransDate >= 01\01\2007 && ledgerTrans.TransDate <= 31\01\2007
    {
        //if (! row) timeStart = timenow();  // для оценки времени собственно вывода (для полного - закомментировать)
        row++;
        if (row > 50000) break;

        stmt2exec = strFmt('duringLoop %1,"%2","%3","%4",%5,"%6",%7,"%8",%9,"%10"',
            int2str(ledgerTrans.RecId),
            ledgerTrans.AccountNum,
            ledgerTable.AccountName,
            strfmt('%1', ledgerTable.AccountPlType),
            int2str(ledgerTrans.BondBatchTrans_RU),
            ledgerTrans.BondBatch_RU,
            strFmt('DateSerial(%1,%2,%3)', year(ledgerTrans.TransDate),
                                           mthofyr(ledgerTrans.TransDate),
                                           dayofmth(ledgerTrans.TransDate)),
            strReplace(ledgerTrans.Txt,'"','""'), // для полей, в которых возможны двойные кавычки
            num2str(ledgerTrans.AmountMST,-1,-1,1,0),
            strfmt('%1', ledgerTrans.Crediting));

        sc.ExecuteStatement(stmt2exec);
    }

    sc.ExecuteStatement('afterLoop');

    info(strFmt('Время выполнения, %1 сек',timenow()-timeStart));
}

Больше пока ничего говорить не буду. Запустите, посмотрите сами, пропустите через себя код.

Если джоб вдруг не запустится по причине отсутствия MSScriptControl'а на компьютере, взять его можно отсюда:
http://www.microsoft.com/download/en...s.aspx?id=1949
или отсюда http://www.runweloads.com/inter/publish/61204prog.html

Приведу также несколько ссылок для справки, которые мне наиболее понравились в процессе изучения вопроса:

Using the ScriptControl
Использование объекта Microsoft Script Control в среде 1С:Предприятие v7.7
Add Scripting to Your Apps with Microsoft ScriptControl
Использование Microsoft ScriptControl

Хочу также заметить, что демонстрация мощи данного инструмента на примере экспорта в Excel - лишь дань сложившейся традиции, способ привлечь внимание общественности для показа вкусностей. Кстати,о некоторых вкусностях хорошо говорится во второй ссылке (про 1С).

[Ace of Database]

Спасибо за открытие новых горизонтов! Все-таки технологии 1998-2001 годов до сих пор рулят! Это было время наступления сингулярности в программировании
Жаль, что в Аксапте можно программировать на Бейсике только в строковых константах!

PS: я конечно немножко преувеличиваю

PS2: для лучшей популярности темы, лучше было бы ее назвать как-нибудь вроде "Найден новый способ выгрузки в Excel" или "Интегрируем Visual Basic в Аксапту".

[Gustav]

Цитата:

Сообщение от Ace of Database

Все-таки технологии 1998-2001 годов до сих пор рулят! Это было время наступления сингулярности в программировании

Ace, шикарное философское замечание! Прочитал - несколько минут просто сидел, приятно размышляя и ностальгируя. Впрочем, ностальгируя ли, если что-то из того мы открываем (наконец-таки!) только сейчас? К слову, я ж теперь в SAP'е на ABAP'е практикую, так там мне видится достаточный простор для внедрения технологий 1998-2001.

Цитата:

Сообщение от Ace of Database

Жаль, что в Аксапте можно программировать на Бейсике только в строковых константах!

Согласен. Хотя это же лишь финальная форма представления отлаженного кода. А программировать можно вполне комфортно в любом VB-хосте (Visual Studio, Excel и др.), не забывая об ограниченности скриптовой версии языка. Хотя, справедливости ради, Basic и в урезанном виде велик!

Цитата:

Сообщение от Ace of Database

лучше было бы ее назвать как-нибудь вроде "Найден новый способ выгрузки в Excel"

Как я уже написал выше, "выгрузка в Excel" просто хорошая возможность демонстрации законченного примера. Следует сразу настроиться на более широкий кругозор. Например, можно применить тот же ADODB.Recordset для решения задач сортировки и фильтрации в оперативной памяти, без какой-либо связи с Excel'ем, конкурируя с такими родными средствами Аксы, как Set или Map.

Цитата:

Сообщение от Ace of Database

или "Интегрируем Visual Basic в Аксапту".

MSScriptControl в качестве языка может использовать и JScript, так что не Бейсиком единым. Кстати, будет здорово, если кто-нибудь смастерит и выложит здесь примерчик со скриптом на Джаве. Welcome!

Не, не будем переименовывать. В конце концов дайте же мне потешить мои скромные амбиции - уже вторая тема с заголовком "Поговорим o...". Рубрика-с, однако!

[Gustav]

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

Перед запуском нижеследующего джоба следует прогнать вышеупомянутый джоб, который выводит матрицу 50000х10 и сохранить получившийся файл (у меня это mssc_output.xls - у себя пропишите свой). Далее скорее запускайте джоб из этого поста и обнаружьте, что это реально "нечеловеческая музыка" (с):

static void Job_ReadFromExcel(Args _args)
{
    COM sc;
    str vbCode;
    int i,j;
    int timeStart = timenow();
    str file  = @'C:\Documents and Settings\kulvinov\My Documents\mssc_output.xls';
    str range =  'A2:J50001'; // 50000 x 10
    COMVariant dummy, rowsCount, colsCount;
    ;

    vbCode =
    'Option Explicit                                                        \r\n' +
    'Dim varArray                                                           \r\n' +
    'Sub readRangeToVarArray(fileName, rngAddr)                             \r\n' +
    '    Dim xlApp                                                          \r\n' +
    '    Dim rng                                                            \r\n' +
    '    Dim wbk                                                            \r\n' +
    '    Set xlApp = CreateObject("Excel.Application")                      \r\n' +
    '    With xlApp                                                         \r\n' +
    '        Set rng = .Workbooks.Open(fileName).Application.Range(rngAddr) \r\n' +
    '        varArray = rng.Value                                           \r\n' +
    '        Set rng = Nothing                                              \r\n' +
    '        For Each wbk In .Workbooks                                     \r\n' +
    '            wbk.Close False                                            \r\n' +
    '        Next                                                           \r\n' +
    '        Set wbk = Nothing                                              \r\n' +
    '        .Quit                                                          \r\n' +
    '    End With                                                           \r\n' +
    '    Set xlApp = Nothing                                                \r\n' +
    'End Sub                                                                \r\n'
    ;

    sc = new COM('MSScriptControl.ScriptControl');
    sc.Language('vbscript');

    sc.AddCode( vbCode );
    sc.ExecuteStatement(strFmt('readRangeToVarArray "%1", "%2"',file,range));

    info(strFmt('Время окончания считывания, %1 сек',timenow()-timeStart));

    rowsCount = sc.Eval('UBound(varArray,1)');
    info(strFmt('Количество строк в массиве: %1',rowsCount.long()));
    colsCount = sc.Eval('UBound(varArray,2)');
    info(strFmt('Количество столбцов в массиве: %1',colsCount.long()));

    for (i=1; i<=rowsCount.long(); i++) // цикл по строкам varArray
    {
        for (j=1; j<=colsCount.long(); j++) // цикл по столбцам varArray
        {
            dummy = sc.Eval(strFmt('varArray(%1,%2)',i,j));
            //print strFmt('%1 -- %2 -- %3 -- %4 -- %5',
            //             i,j,dummy.bStr(),dummy.double(),dummy.date());
        }
    }

    info(strFmt('Время окончания перебора всех значений, %1 сек',timenow()-timeStart));
}

Как можно понять, джоб (в его VB-части) считывает из листа Excel диапазон A2:J50001 в одну переменную varArray (одной операцией присваивания! с невероятной скоростью этой операции! и это обещанная изюминка), после чего Excel отпускается, и уже Аксапта в двойном цикле "трогает" по очереди все значения массива в операторе присваивания "dummy = ...". Можно раскомментировать оператор print, чтобы убедиться, что данные реально считываются. Несколько нелепый (и bStr, и double, и date в одном флаконе) print сделан на скорую руку по принципу "уж в одной из позиций strFmt правильное значение ячейки да отобразится".

С закомментированным print мои результаты в инфологе таковы:

Info Сообщение (20:02:24) Время окончания считывания, 0 сек
Info Сообщение (20:02:24) Количество строк в массиве: 50000
Info Сообщение (20:02:24) Количество столбцов в массиве: 10
Info Сообщение (20:02:24) Время окончания перебора всех значений, 21 сек

И данные-то можно читать в совершенно произвольном порядке, никакие "только вперёдные" курсоры нас не лимитируют! Красота!

Ну, вот. На сегодня я, пожалуй, всё сказал. Пошёл в отпуск на недельку. До встречи!

[Ace of Database]

Вот это да!
Прощайте, буфер обмена и преобразование строк в контейнеры!

[Ivanhoe]

Кто-нибудь пользуется в промышленной эксплуатации?

[Gustav]

Цитата:

Сообщение от Ivanhoe

Кто-нибудь пользуется в промышленной эксплуатации?

Я, в САПе. Естественно, при выгрузке в Excel

Работает без нареканий. В продуктивной системе компании уже с год, наверное. Без него я бы там свои Excel'но-ADO-шные наработки не воплотил (собственно из-за желания воплотить их, столкнувшись с низкой скоростью выполнения после переноса алгоритма "в лоб", я и нарыл этот способ - да здравствуют трудности как двигатель прогресса!).

САП критичен к количеству вызовов методов OLE-объектов (Аксапта не так критична), без SC было бы очень медленно, а c SC количество вызовов можно минимизировать. Например, я передаю скрипту огромную строку с данными и запускаю метод в скрипте (т.е. имеем всего два OLE-вызова "SAP-VBA"), а дальше скрипт уже дербанит строку своими силами (операторами VBA).

[Gustav]

Чтобы не быть голословным, для примера приведу текст боевого метода (p.s. даже двух) на ABAP'е из своего класса выгрузки. Основное место занимает формирование текста модуля путем слияния (CONCATENATE) текстовых строк - операторов VBA:

  METHOD build_vbcode.
    "формирование полного текста VB-модуля для обслуживания конкретной внутр.таблицы

    DATA: flds_cnt_mns1  TYPE string,
          num2str        TYPE string.
    DATA: vbcode1        TYPE string,
          vbcode2        TYPE string,
          vbcode3        TYPE string,
          vbcode4        TYPE string,
          vbcode5        TYPE string,
          vbcode6        TYPE string,
          vbcode7        TYPE string,
          vbcode8        TYPE string,
          vbcode9        TYPE string.

    DATA  strtab         TYPE STANDARD TABLE OF string.

    flds_cnt_mns1 = me->flds_cnt - 1.

    CONCATENATE `Public f(` flds_cnt_mns1 `), headers(` flds_cnt_mns1 `)`
            INTO vbcode1.
    CONCATENATE `    For i = 0 To ` flds_cnt_mns1
            INTO vbcode2.

    CONCATENATE `    arr = Split(strParams, "` me->val_separator `")`
            INTO vbcode3.

    IF me->xl_sheetname IS NOT INITIAL.
      CONCATENATE `    wks.Name = "` me->xl_sheetname `"`
              INTO vbcode4.
    ENDIF.

    IF me->xl_visible = abap_true.
      vbcode5 = `    xlApp.Visible = True`.
    ENDIF.

    IF me->xl_sheetindex > 0.
      num2str = me->xl_sheetindex.
    ELSE.
      num2str = '0'.
    ENDIF.


    "KKU, 11.04.2012 -->
    "в процессе работ по тр. 1014 
    IF me->xl_shtrewrite = abap_false.

      CONCATENATE `    Call setSheetForOutput(` num2str `, False)` "выводим на абсолютно чистый лист
              INTO vbcode6.
    ELSE.

      CONCATENATE `    Call setSheetForOutput(` num2str `, True)` "выводим на любой лист (перезаписываем)
              INTO vbcode6.
    ENDIF.
    "<-- KKU, 11.04.2012

    IF me->xl_workbook IS INITIAL. "если рабочая книга создается заново
      CONCATENATE `    Set xlApp = CreateObject("Excel.Application")`
                   cl_abap_char_utilities=>cr_lf
                  `    Set wbk = xlApp.Workbooks.Add`
            INTO vbcode7.
    ELSE. "если выводим в ту же рабочую книгу, что и раньше
      vbcode7   = `    Set xlApp = wbk.Application`.
    ENDIF.


    IF me->rs_maxcolumns > 0 AND me->rs_maxcolumns < me->flds_cnt.
      "если кол-во выводимых колонок ограничено конкретным значением (считая слева от первой)
      num2str = me->rs_maxcolumns.
      CONCATENATE `        wks.Range("A2").CopyFromRecordset rst, ,` num2str
            INTO vbcode8.
      CONCATENATE `                               wks.Cells(1, ` num2str `))`
            INTO vbcode9.
    ELSE.
      "если кол-во выводимых колонок не указано
      vbcode8   = `        wks.Range("A2").CopyFromRecordset rst`.
      vbcode9   = `                               wks.Cells(1, UBound(headers) + 1))`.
    ENDIF.

    CALL METHOD me->build_recordset( ).

    CONCATENATE `Option Explicit`

                `Public rst`
                `Public wbk, wks, rngHeaders, rngITab`
                 vbcode1 "Public f( ... ), headers( ... )
                `Public captions`

                `Sub setCaptions(strCaptions, separator)`
                `    captions = Split(strCaptions, separator)`
                `End Sub`

                `Sub beforeLoop()`
                `    Dim i`
                `    Set rst = CreateObject("ADODB.Recordset")`
                 me->all_field_append "rst.Fields.Append
                `    rst.Open`
                 vbcode2 "For i = 0 To ...
                `        Set f(i) = rst.Fields(i)`
                `        headers(i) = f(i).Name`
                `        If IsArray(captions) Then` "прописывание заголовков, если есть; иначе - имена полей
                `            If i <= UBound(captions) Then`
                `                If captions(i) <> "" Then`
                `                    headers(i) = captions(i)`
                `                End If`
                `            End If`
                `        End If`
                `    Next`
                `End Sub`

                `Sub duringLoop(strParams)`
                `    Dim arr`
                 vbcode3 "arr = Split(strParams, "~~")`
                `    rst.AddNew`
                 me->all_field_setval "f(0).Value = ...
                `End Sub`

                `Sub afterLoop()`
                `    Dim xlApp`
                `    Dim cell`
                 vbcode7 "Set xlApp = CreateObject("Excel.Application") или Set xlApp = wbk.Application
                         "Set wbk = xlApp.Workbooks.Add
                 vbcode6 "Call setSheetForOutput( ... )
                `    If Not (rst.BOF And rst.EOF) Then`
                `        rst.Update`
                 vbcode8 "wks.Range("A2").CopyFromRecordset rst, ,...
                `        Call formatTimeColumns`
                `    End If`
                `    Set rngHeaders = wks.Range(wks.Cells(1, 1), _`
                 vbcode9 "wks.Cells(1, кол-во столбцов ))
                `    With rngHeaders`
                `        .Value = headers`
                `        .Font.Bold = True`
                `        If Not (rst.BOF And rst.EOF) Then`
                `            rst.MoveLast` "формально для правильного определения RecordCount
                `            Set rngITab = .Resize(rst.RecordCount + 1)` "CurrentRegion здесь не подходит из-за возможных пропусков
                `            rngITab.AutoFilter`
                `        Else`
                `            Set rngITab = rngHeaders` "если рекордсет пустой
                `        End If`
                `        .EntireColumn.AutoFit`
                `        .Borders.LineStyle = 1`
                `    End With`
                `    For Each cell In rngHeaders`
                `        If cell.ColumnWidth > 35 Then cell.ColumnWidth = 35`
                `    Next`
                `    wks.Cells(2, 1).Select`
                `    xlApp.ActiveWindow.FreezePanes = True`
                 vbcode4 "wks.Name = ...
                 vbcode5 "xlApp.Visible = ...
                `End Sub`

                `Sub setWorkbook(refToWorkbook)`
                `    Set wbk = refToWorkbook`
                `End Sub`

                `Function getWorkbook()` "выдает наружу ссылку на используемую рабочую книгу
                `    Set getWorkbook = wbk`
                `End Function`

                `Function getWorksheet()` "выдает наружу ссылку на используемый рабочий лист
                `    Set getWorksheet = wks`
                `End Function`

                `Function getITabRange()` "выдает наружу ссылку на диапазон выгруженной внутр.таблицы (заголовки+данные)
                `    Set getITabRange = rngITab`
                `End Function`

                `Sub setSheetForOutput(idx2add, rewrite)` "KKU, 11.12.2011, добавление параметра rewrite - перезаписывать лист
                `    Dim wkssCnt`
                `    Dim wkss`
                `    Set wkss = wbk.Worksheets`
                `    wkssCnt = wkss.Count`
                `    If idx2add = 0 Then`
                `        For Each wks In wkss`
                `            If wks.UsedRange.Address(False, False) = "A1" And IsEmpty(wks.Range("A1").Value) And idx2add = 0 Then`
                                 "если лист пустой и это первый пустой лист, то его и запоминаем
                `                idx2add = wks.Index`
                `            End If`
                `        Next`
                `    End If`
                `    If idx2add = 0 Then`
                         "если после перебора коллекции свободного листа всё еще не нашлось, добавляем последний (новый)
                `        idx2add = wkssCnt + 1`
                `    End If`
                `    If idx2add > wkssCnt Then`
                `        Set wks = wkss.Add(, wkss(wkssCnt), idx2add - wkssCnt)` "и лист становится активным (самый последний, если несколько)
                `    Else`
                         "проверяем, можно ли выводить на этот лист? т.е. пустой ли он?
                `        Set wks = wkss.Item(idx2add)` "здесь лист НЕ становится активным
                `        wks.Activate` "поэтому активируем его принудительно! иначе - КОВАРНАЯ ТРУДНОУЛОВИМАЯ ОШИБКА
                                           "эта активация нужна для избежания ошибки при выполнении xlApp.ActiveWindow.FreezePanes
                `        If Not rewrite Then` "KKU, 11.12.2011, если нельзя перезаписывать - деликатное вмешательство
                `            If Not (wks.UsedRange.Address(False, False) = "A1" And IsEmpty(wks.Range("A1").Value)) Then`
                                 "если лист не пустой - вставляем перед ним новый - before
                `                Set wks = wkss.Add(wks)` "и вставленный лист становится активным
                `            End If`
                `        End If`
                `    End If`
                `End Sub`

                `Sub activateFirstSheet()`
                `    wbk.Worksheets(1).Activate`
                `    wbk.Worksheets(1).Range("A1").Select`
                `End Sub`

                `Sub formatTimeColumns()`
                `    Dim rng, fld`
                `    Dim arr()`
                `    Dim i, cnt`
                `    For i = 0 To rst.Fields.Count - 1`
                `        Set fld = rst.Fields.Item(i)`
                `        If fld.Type = 7 Then` "а дата у нас - 133
                `            ReDim Preserve arr(cnt)`
                `            arr(cnt) = i + 1`
                `            cnt = cnt + 1`
                `        End If`
                `    Next`
                `    If cnt > 0 Then` "если колонки времени есть в принципе
                `        For i = LBound(arr) To UBound(arr)`
                `            If i = 0 Then`
                `                Set rng = wks.UsedRange.Columns(arr(i))`
                `            Else`
                `                Set rng = wks.Application.Union(rng, wks.UsedRange.Columns(arr(i)))`
                `            End If`
                `        Next`
                `        rng.NumberFormat = "hh:mm:ss"`
                `    End If`
                `End Sub`

            INTO me->vbcode
            SEPARATED BY cl_abap_char_utilities=>cr_lf.

  ENDMETHOD.                    "build_vbcode


  METHOD build_recordset.
    "формирует часть VB-кода, ответственного за создание и "обслуживание" recordset'а

    DATA wa_comp          TYPE abap_compdescr.
    DATA adofldtyp        TYPE string.
    DATA one_field_append TYPE string.
    DATA one_field_setval TYPE string.
    DATA idx              TYPE string.
    DATA temp             TYPE string.

    LOOP AT me->compdescr_tab INTO wa_comp.

      idx = sy-tabix - 1.

      adofldtyp = me->ado_field_type_by_type( inttype   = wa_comp-type_kind
                                              leng      = wa_comp-length
                                              decimals  = wa_comp-decimals ).

      "подготовка VB-операторов добавление полей
      CONCATENATE `    rst.Fields.Append "` wa_comp-name `",` adofldtyp
             INTO one_field_append.

      CONCATENATE me->all_field_append one_field_append
             INTO me->all_field_append
             SEPARATED BY cl_abap_char_utilities=>cr_lf.

      "подготовка VB-операторов для установки значений
      CASE adofldtyp.
        WHEN ' 133'. "дата
          CONCATENATE `    If arr(` idx `) <> "" And arr(` idx `) <> "00000000" Then`
                 INTO temp.
          CONCATENATE `        f(` idx `).Value = DateSerial(Left(arr(` idx `), 4), Mid(arr(` idx `), 5, 2), Right(arr(` idx `), 2))`
                 INTO one_field_setval.
          CONCATENATE temp one_field_setval `    End If`
                 INTO one_field_setval
                 SEPARATED BY cl_abap_char_utilities=>cr_lf.

        WHEN ' 7'. "время (как дата) - более подходящего типа не нашлось
          CONCATENATE `    If arr(` idx `) <> "" Then`
                 INTO temp.
          CONCATENATE `        f(` idx `).Value = TimeSerial(Left(arr(` idx `), 2), Mid(arr(` idx `), 3, 2), Right(arr(` idx `), 2))`
                 INTO one_field_setval.
          CONCATENATE temp one_field_setval `    End If`
                 INTO one_field_setval
                 SEPARATED BY cl_abap_char_utilities=>cr_lf.

        WHEN ' 3'. "целые
          CONCATENATE `    f(` idx `).Value = CLng(arr(` idx `))`
                 INTO one_field_setval.

        WHEN ' 5'. "веществ.
          CONCATENATE `    f(` idx `).Value = CDbl(arr(` idx `))`
                 INTO one_field_setval.

        WHEN ' 6'. "денежные
          CONCATENATE `    f(` idx `).Value = CCur(arr(` idx `))`
                 INTO one_field_setval.

        WHEN OTHERS. "строки
          CONCATENATE `    f(` idx `).Value = arr(` idx `)`
                 INTO one_field_setval.
      ENDCASE.

      CONCATENATE me->all_field_setval one_field_setval
             INTO me->all_field_setval
             SEPARATED BY cl_abap_char_utilities=>cr_lf.

    ENDLOOP.
    "последние символы общей строки можно не удалять - они не мешают строкам VB-модуля

  ENDMETHOD.                    "build_recordset

Отладка такого кода, конечно, не подарок. Но если потихоньку, пофрагментно в нормальном VB(VBA), то вполне одолимо. Результат того стоит.