从excel表中读取数据并使用vba宏将其输出到xml？

Question

I have some data in an excel table in a format similar to the one below.

    Colum1_Heading       Column2_Heading
          a                   1
          b                   2
          c                   3

I am trying to convert the data in this table to XML, I will always have the same number of columns but an indeterminate number of rows.

The XML format is something like this

<?xml version="1.0" encoding="utf-8"?>
<root> 
    <tag1>
         <tag2>
              a - 1,
              b - 2,
              c - 3
         </tag2>
    </tag1>
</root>

So I think it should be fairly simple. So far I've started writing some code that creates a writeable string which I would then write to a new XML file, but I'm pretty new to VBA so I'm still researching a bunch on the internet. I've inputted the header and the beginning and end tags since those will always be the same. My question is how to read the rows of the table and write them to the XML in a format shown above. Any help would be appreciated. Please let me know if you need any additional info.

Answer 1

This should get you started. Add a reference to MSXML2:

Sub Test()
    With New MSXML2.DOMDocument60

        Dim root As IXMLDOMNode
        Set root = .createElement("root")

        Dim tag1 As IXMLDOMNode
        Set tag1 = .createElement("tag1")

        Dim tag2 As IXMLDOMNode
        Set tag2 = .createElement("tag2")

        tag2.Text = ReadXmlContentFromWorksheet '"a - 1,b - 2,c - 3"

        tag1.appendChild tag2
        root.appendChild tag1

        .appendChild .createProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")
        Set .DocumentElement = root
        '.Save "test.xml"
        Debug.Print .XML

    End With
End Sub

Output:

 <?xml version="1.0"?> <root><tag1><tag2>a - 1,b - 2,c - 3</tag2></tag1></root> 

Note that the vertical whitespace is irrelevant

---

The ReadXmlContentFromWorksheet function would look something like this:

Private Function ReadXmlContentFromWorksheet() As String
    Dim result As String

    Dim lastRow As Long
    lastRow = MyDataSheet.Range("A" & MyDataSheet.Rows.Count).End(xlUp).Row

    Dim currentRow As Long
    For currentRow = 1 To lastRow
        result = result & MyDataSheet.Cells(currentRow, 1).Value & " - " _
                        & MyDataSheet.Cells(currentRow, 2).Value
        result = IIf(currentRow = lastRow, vbNullString, ",")
    Next

    ReadXmlContentFromWorksheet = result
End Function