如何通過 Excel 創建一個元素內包含多個元素的 XML 文件？

Question

我需要創建一個 xml 文件，其中我有這個結構：

       <term name="example 1">
           <customAttributes>
               <customAttributeValue customAttribute="xyz"> 
               <customAttributeReferences> 
                   <columnRef table="a" column="x"/>
                   <columnRef table="b" column="x"/>
                   <columnRef table="c" column="x"/>
               </customAttributeReferences> 
               </customAttributeValue>
       </term>

我只使用 excel 來創建文件，但我能夠導出的唯一結構是：

<term name="example 1">
            <customAttributes>
                <customAttributeValue customAttribute="xyz"> 
                <customAttributeReferences> 
                    <columnRef table="a" column="x"/>
                </customAttributeReferences> 
                </customAttributeValue>
        </term>
<term name="example 1">
            <customAttributes>
                <customAttributeValue customAttribute="xyz"> 
                <customAttributeReferences> 
                    <columnRef table="b" column="x"/>
                </customAttributeReferences> 
                </customAttributeValue>
        </term>
<term name="example 1">
            <customAttributes>
                <customAttributeValue customAttribute="xyz"> 
                <customAttributeReferences> 
                    <columnRef table="c" column="x"/>
                </customAttributeReferences> 
                </customAttributeValue>
        </term>

我的表結構是這樣的：

| terms      | table     | column |
| --------   | ----------| ------ |
| example 1  | a         | x      |
| example 1  | b         | x      |
| example 1  | c         | x      |

有人能幫我嗎？ 如有必要，我可以使用 VBA。 謝謝！

Answer 1

嘗試這個。 相當多的代碼，但其中大部分是實用方法 - 只有Tester特定於您的任務。

Sub Tester()

    Dim XML As Object, rt As Object
    Dim id, currId, el As Object, rw As Range
    
    Set XML = EmptyDocument()
    Set rt = CreateWithAttributes(XML, "myroot", , , XML)
    
    Set rw = ActiveSheet.Range("A2:E2")  'first row of data…
    currId = Chr(0) 'some non-value
    
    Do While Application.CountA(rw) > 0
        id = rw.Cells(1).Value
        If id <> currId Then     'new name? Set up `term` element
            Set el = CreateWithAttributes(XML, "term", , _
                         Array("name", id, "status", "CANDIDATE", "type", rw.Cells(2).Value), rt)
            Set el = CreateWithAttributes(XML, "customAttributes", , , el)
            Set el = CreateWithAttributes(XML, "customAttributeValue", , _
                         Array("customAttribute", rw.Cells(3).Value), el)
            Set el = CreateWithAttributes(XML, "customAttributeReferences", , , el)
            currId = id
        End If
        
        CreateWithAttributes XML, "columnRef", , _
              Array("table", rw.Cells(4).Value, "column", rw.Cells(5).Value), el
        
        Set rw = rw.Offset(1, 0)
    Loop
    
    Debug.Print PrettyPrintXML(XML.XML)
End Sub


' ### everything below here is a utility method ###

'Utility method: create and return an element, with
'   optional value and attributes.
'Optionally append the newly-created element to parentEl
Function CreateWithAttributes(doc As Object, elName As String, _
                Optional elValue As String = "", Optional attr As Variant = Empty, _
                Optional parentEl As Object = Nothing) As Object
    Dim el, u, i As Long, att As Object, txt As Object
    'create the node
    Set el = doc.CreateNode(1, elName, "")
    'if have attributes, loop and add
    'passed in as Array(attr1Name, attr1Value, attr2Name, attr1Value,...)
    If Not IsEmpty(attr) Then
        For i = 0 To UBound(attr) Step 2
            Set att = doc.CreateAttribute(attr(i))
            att.Value = attr(i + 1)
            el.Attributes.setNamedItem att
        Next i
    End If
    'any element content to add?
    If Len(elValue) > 0 Then
        Set txt = doc.createTextNode(elValue)
        el.appendchild txt
    End If
    'add to document?
    If Not parentEl Is Nothing Then parentEl.appendchild el
    
    Set CreateWithAttributes = el
End Function

'create and return an empty xml doc
Function EmptyDocument() As Object
    Dim XML
    Set XML = CreateObject("MSXML2.DOMDocument")
    XML.LoadXML ""
    XML.appendchild XML.createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""")
    Set EmptyDocument = XML
End Function

'https://stackoverflow.com/questions/1118576/how-can-i-pretty-print-xml-source-using-vb6-and-msxml
Public Function PrettyPrintXML(XML As String) As String

  Dim Reader As Object 'New SAXXMLReader60
  Dim Writer As Object 'New MXXMLWriter60
  
  Set Reader = CreateObject("MSXML2.SAXXMLReader.6.0")
  Set Writer = CreateObject("MSXML2.MXXMLWriter.6.0")
  
  Writer.indent = True
  Writer.standalone = False
  Writer.omitXMLDeclaration = False
  Writer.Encoding = "utf-8"

  Set Reader.contentHandler = Writer
  Set Reader.dtdHandler = Writer
  Set Reader.errorHandler = Writer

  Call Reader.putProperty("http://xml.org/sax/properties/declaration-handler", _
          Writer)
  Call Reader.putProperty("http://xml.org/sax/properties/lexical-handler", _
          Writer)

  Call Reader.Parse(XML)

  PrettyPrintXML = Writer.output

End Function