Макрос вывода в XML со вложенностью и условиями

Пользователь

Сообщений: 8 Регистрация: 25.03.2015

27.03.2015 01:36:23

Помогите пожалуйста найти ошибку в макросе
Экспорт таблицы в XML, повторяющиеся родительские элементы должны объединятся в один, который содержит дочерние элементы. Уровни у элементов могут отсутствовать, (в таблице это "-" ) в xml пропущенные уровни исключаются.
На втором уровне элементов XML файла проблема, если встречаются повторяющиеся элементы они не объединяются в один, а отрабатывает только первый
В таблице это, например, во второй колонке "КАСКО" "ОСАГО" "Займ"

xml файл получается (часть кода)

Код

<sector id="Страхование" name="Страхование">
<product id="ОСАГО" name="ОСАГО">
<problem id="Навязывание дополнительных услуг" name="Навязывание дополнительных услуг"/>
</product>

<problem id="Отказ в заключении договора" name="Отказ в заключении договора"/>
<problem id="Отказ в выплате страхового возмещения" name="Отказ в выплате страхового возмещения"/>
<problem id="Нарушение сроков выплаты" name="Нарушение сроков выплаты"/>
<problem id="Неверное применение КБМ" name="Неверное применение КБМ"/>
<problem id="Отказ в приеме/выдаче документов" name="Отказ в приеме/выдаче документов"/>
<problem id="Несогласие с размером страхового возмещения" name="Несогласие с размером страхового возмещения"/>
<problem id="Удаленность пунктов" name="Удаленность пунктов"/>
<problem id="Прочее" name="Прочее"/>

<product id="КАСКО" name="КАСКО">
<problem id="Нарушение сроков и порядка выплаты" name="Нарушение сроков и порядка выплаты"/>
</product>

<problem id="Отказ в выплате страхового возмещения" name="Отказ в выплате страхового возмещения"/>
<problem id="Несогласие с качеством и сроками ремонта" name="Несогласие с качеством и сроками ремонта"/>
<problem id="Несогласие с размером страхового возмещения" name="Несогласие с размером страхового возмещения"/>
<problem id="Несогласие с размером страховой премии" name="Несогласие с размером страховой премии"/>
<problem id="Прочее" name="Прочее"/>

<product id="Страхование жизни" name="Страхование жизни"/>
<product id="Страхование от несчастных случаев" name="Страхование от несчастных случаев"/>
<product id="Страхование профессиональной ответственности" name="Страхование профессиональной ответственности"/>
<product id="Добровольное медицинское страхование" name="Добровольное медицинское страхование"/>
<product id="Другие продукты" name="Другие продукты"/>
<product id="Банкротство" name="Банкротство"/>
<product id="Прочее" name="Прочее"/>

</sector>

а требуется

Код

<sector id="Страхование" name="Страхование">
<product id="ОСАГО" name="ОСАГО">
<problem id="Навязывание дополнительных услуг" name="Навязывание дополнительных услуг"/>
<problem id="Отказ в заключении договора" name="Отказ в заключении договора"/>
<problem id="Отказ в выплате страхового возмещения" name="Отказ в выплате страхового возмещения"/>
<problem id="Нарушение сроков выплаты" name="Нарушение сроков выплаты"/>
<problem id="Неверное применение КБМ" name="Неверное применение КБМ"/>
<problem id="Отказ в приеме/выдаче документов" name="Отказ в приеме/выдаче документов"/>
<problem id="Несогласие с размером страхового возмещения" name="Несогласие с размером страхового возмещения"/>
<problem id="Удаленность пунктов" name="Удаленность пунктов"/>
<problem id="Прочее" name="Прочее"/>
</product>

<product id="КАСКО" name="КАСКО">
<problem id="Нарушение сроков и порядка выплаты" name="Нарушение сроков и порядка выплаты"/>
<problem id="Отказ в выплате страхового возмещения" name="Отказ в выплате страхового возмещения"/>
<problem id="Несогласие с качеством и сроками ремонта" name="Несогласие с качеством и сроками ремонта"/>
<problem id="Несогласие с размером страхового возмещения" name="Несогласие с размером страхового возмещения"/>
<problem id="Несогласие с размером страховой премии" name="Несогласие с размером страховой премии"/>
<problem id="Прочее" name="Прочее"/>
</product>


<product id="Страхование жизни" name="Страхование жизни"/>
<product id="Страхование от несчастных случаев" name="Страхование от несчастных случаев"/>
<product id="Страхование профессиональной ответственности" name="Страхование профессиональной ответственности"/>
<product id="Добровольное медицинское страхование" name="Добровольное медицинское страхование"/>
<product id="Другие продукты" name="Другие продукты"/>
<product id="Банкротство" name="Банкротство"/>
<product id="Прочее" name="Прочее"/>

</sector

Прикрепленные файлы

dsoonfomini.xlsm (27.27 КБ)

Doober

Пользователь

Сообщений: 2326 Регистрация: 09.04.2013

27.03.2015 04:24:34

Цитата
Solex написал: Помогите пожалуйста найти ошибку в макросе

У вас не ошибка,у вас не верный алгоритм работы макроса.
Вам надо проверять наличие родителя через xPath.Если таковой в наличии,то добавлять к нему.
Иначе создаете новый,и проверяете для него наличие родителя.
Это непростая задача объединить данные в xml.

Solex Пользователь Сообщений: 8 Регистрация: 25.03.2015	#3 27.03.2015 09:35:30 Помогите с кодом куда и как этот xPath вставить ?

Doober

Пользователь

Сообщений: 2326 Регистрация: 09.04.2013

27.03.2015 14:23:50

Сказал бы куда вставить:D

Скрытый текст

Код

Sub Convert_Excel_Data_to_XML()
    Dim doc As MSXML2.DOMDocument60
    Dim root As MSXML2.IXMLDOMElement
    Dim product_ As MSXML2.IXMLDOMElement
    Dim problem_ As MSXML2.IXMLDOMElement
    Dim sector_ As MSXML2.IXMLDOMElement
    Dim xmlDecl As MSXML2.IXMLDOMProcessingInstruction
    Dim sXmlFilePath As String, DX

    'Создаём новый XML документ
    Set doc = New MSXML2.DOMDocument60

    'Путь для сохранения XML файла
    sXmlFilePath = ThisWorkbook.Path & "\Output.xml"

    doc.setProperty "SelectionLanguage", "XPath"

    'XML декларация
    Set xmlDecl = doc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
    doc.appendChild xmlDecl

    'Добавляем корневой элемент
    Set root = doc.createElement("typology")
    root.setAttribute "xmlns:xs", "type"
    doc.appendChild root

    'Добавляем новый элемент в корневой элемент
    DX = Range(Range("a5"), Range("a" & Rows.Count).End(xlUp)).Resize(, 9)

    For n = 1 To UBound(DX)
        sector$ = DX(n, 1)
        product$ = DX(n, 2)
        problem$ = DX(n, 3)
        formOption$ = DX(n, 4)
        XPath = "//sector [@id='" & sector$ & "']"
        Set oNodes = doc.SelectSingleNode(XPath)
        If oNodes Is Nothing Then
            Set sector_ = doc.createElement("sector")
            sector_.setAttribute "id", sector$
            sector_.setAttribute "name", sector$
            root.appendChild sector_
        Else
            Set sector_ = oNodes
        End If
        If product$ <> "-" Then
            XPath = "product [@id='" & product$ & "']"

            Set oNodes = sector_.SelectSingleNode(XPath)
            If oNodes Is Nothing Then
                Set product_ = doc.createElement("product")
                product_.setAttribute "id", product$
                product_.setAttribute "name", product$
                sector_.appendChild product_
            Else
                Set product_ = oNodes
            End If
            If problem$ <> "-" Then
                Set problem_ = doc.createElement("problem")
                problem_.setAttribute "id", problem$
                problem_.setAttribute "name", problem$
                product_.appendChild problem_

            End If

        Else

            If problem$ <> "-" Then
                Set problem_ = doc.createElement("problem")
                problem_.setAttribute "id", problem$
                problem_.setAttribute "name", problem$
                sector_.appendChild problem_
            End If

        End If
    Next
    
    doc.Save sXmlFilePath
End Sub

Изменено: Doober - 27.03.2015 14:26:02

Solex Пользователь Сообщений: 8 Регистрация: 25.03.2015	#5 29.03.2015 03:17:44 Спасибо большое)