使用 Excel VBA 创建 XML 文件

Question

我尝试从 Excel VBA 创建 xml 文件到我的工作中。

我面临的问题如下。

1. 我花了一天时间尝试在每个元素后面添加结构！--elementx。
2. 而且我无法获得漂亮的格式。

下面您将找到我的 VBA 代码（这些是使用 xml 和 VBA 的 myfisrt 步骤）

感谢您对此的帮助。

Public Sub ExportXMLfile()
Dim doc As Object
Dim Root As Object
Dim pi As Object
Dim Spath As String
Dim Cdata As Object

Dim Product As Object
Dim Element1 As Object
Dim Element2 As Object
Dim Element3 As Object

Set doc = CreateObject("MSXML2.DOMDocument")
Set pi = doc.createProcessingInstruction("xml", " version=""1.0"" encoding=""UTF-8""")
doc.appendChild pi

Set Root = doc.createElement("Document")
doc.appendChild Root
Root.setAttribute "generated", Now
Root.appendChild doc.createTextNode(vbNewLine + vbTab)


Set Root = doc.SelectSingleNode("//Document")

For i = 1 To 3
    
    Set Product = doc.createElement("Product")
    Root.appendChild Product
    Product.appendChild doc.createTextNode(vbNewLine + vbTab + vbTab)
    
    
    Set Element1 = doc.createElement("Element1")
    Product.appendChild Element1
    Set Cdata = doc.createCDATASection("Element1")
    Cdata.Data = i
    Element1.appendChild Cdata
    
    
    
    Set Element2 = doc.createElement("Element2")
    Element2.text = i
    Product.appendChild Element2
    
    
    Set Element3 = doc.createElement("Element3")
    Element3.text = i
    Product.appendChild Element3
    
    Product.appendChild doc.createTextNode(vbNewLine + vbTab)
Next

Root.appendChild doc.createTextNode(vbNewLine)

Debug.Print doc.XML


End Sub

通过我的代码，到目前为止我得到了以下输出。

<?xml version="1.0"?>
<Document generated="11/11/2024 10:24:33 AM">
    <Product>
        <Element1><![CDATA[1]]></Element1><Element2>1</Element2><Element3>1</Element3>
    </Product><Product>
        <Element1><![CDATA[2]]></Element1><Element2>2</Element2><Element3>2</Element3>
    </Product><Product>
        <Element1><![CDATA[3]]></Element1><Element2>3</Element2><Element3>3</Element3>
    </Product>
</Document>

输出实际上应该是这样的。

<?xml version="1.0"?>
<Document generated="11/11/2024 10:24:33 AM">
    <Product>
        <Element1><![CDATA[1]]></Element1><!-- element1 -->
        <Element2>1</Element2><!-- element2 -->
        <Element3>1</Element3><!-- element3 -->
    </Product>
    <Product>
        <Element1><![CDATA[2]]></Element1><!-- element1 -->
        <Element2>2</Element2><!-- element2 -->
        <Element3>2</Element3><!-- element3 -->
    </Product>
    <Product>
        <Element1><![CDATA[3]]></Element1><!-- element1 -->
        <Element2>3</Element2><!-- element2 -->
        <Element3>3</Element3><!-- element3 -->
    </Product>
</Document>

Answer 1

这对我来说很有效，根据您的预期输出，生成的 XML 文件 (Test.xml) 将在包含 Excel 文件的文件夹中创建。

Sub Test()
    Dim objConn As Object, strArgs As String, strSQL As String, i As Integer
    Dim xDoc As Object, objRoot As Object, myNode As Object, Cdata As Object
    Dim ChildNode As Variant, New_ChildNode As Variant
    Dim XML_FileName As String, tempFileName As String
        
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    xDoc.resolveExternals = True
    
    Set objRoot = xDoc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
    Set objRoot = xDoc.InsertBefore(objRoot, xDoc.ChildNodes.Item(0))
    Set objRoot = xDoc.createElement("Document")
    Set xDoc.DocumentElement = objRoot
    
    objRoot.setAttribute "generated", Now
    
    For i = 1 To 3
        Set myNode = xDoc.SelectSingleNode("//Document")
        
        Set ChildNode = xDoc.createElement("Product")
        myNode.appendChild (ChildNode)
        
        Set New_ChildNode = xDoc.createElement("Element1")
        ChildNode.appendChild (New_ChildNode)
        
        Set Cdata = xDoc.createCDATASection("Element1")
        Cdata.Data = i
        New_ChildNode.appendChild Cdata
        
        Set New_ChildNode = xDoc.createElement("Element2")
        ChildNode.appendChild (New_ChildNode)
        
        Set New_ChildNode = xDoc.createElement("Element3")
        ChildNode.appendChild (New_ChildNode)
    Next
    
    tempFileName = "Test"
    XML_FileName = ThisWorkbook.Path & Application.PathSeparator & tempFileName & ".xml"
    xDoc.Save (XML_FileName)
    
    Set myNode = Nothing
    Set New_ChildNode = Nothing
    Set ChildNode = Nothing
    Set objRoot = Nothing
    Set xDoc = Nothing
End Sub

.