我想做的是通过解析 XLS 文件来创建 XML 文件。 一个例子应该更相关:

| tag1      |           |           |           |
|           | tag2      |           |           |
|           |           | tag3      | tag3Value |
|           |           | tag4      | tag4Value |
|           | tag5      |           |           |
|           |           | tag6      | tag6Value |
|           |           |           |           |

如果我们想象那些是单元格，则对于以下 .xml 代码将是等效的。

<tag1>
    <tag2>
        <tag3> tag3Value </tag3>
        <tag4> tag4Value </tag4>
    </tag2>
    <tag5>
        <tag6> tag6Value </tag6>
    </tag5>
</tag1>

通过一次管理一个单元并执行 "<"& cell(x,y)="" &="" "="">"不会那么难 但我想要一个优雅的解决方案。到目前为止，这是我的实现:

Sub lol()
    Sheet1.Activate

    Dim xmlDoc As MSXML2.DOMDocument
    Dim xmlNode As MSXML2.IXMLDOMNode

    Set xmlDoc = New MSXML2.DOMDocument
    createXML xmlDoc
End Sub

Sub createXML(xmlDoc As MSXML2.DOMDocument)
    Dim newNode As MSXML2.IXMLDOMNode

    If Not (Cells(1, 1) = "") Then

        'newNode.nodeName = Cells(1, 1)
        ReplaceNodeName xmlDoc, newNode, Cells(1, 1)

        createXMLpart2 xmlDoc, newNode, 2, 2
        xmlDoc.appendChild newNode
    End If
    xmlDoc.Save "E:\saved_cdCatalog.xml"
End Sub

Sub createXMLpart2(xmlDoc As MSXML2.DOMDocument, node As MSXML2.IXMLDOMElement, i As Integer, j As Integer)
     Dim newNode As MSXML2.IXMLDOMElement
     If Not (Cells(i, j) = "") Then

        If (Cells(i, j + 1) = "") Then

            'newNode.nodeName = Cells(i, j)
            ReplaceNodeName xmlDoc, newNode, Cells(i, j)

            createXMLpart2 xmlDoc, newNode, i + 1, j + 1
        Else
            'newNode.nodeName = "#text"
            ReplaceNodeName xmlDoc, newNode, "#text"

            'newNode.nodeValue = Cells(i, j + 1)
            createXMLpart2 xmlDoc, newNode, i + 1, j
        End If
        node.appendChild (newNode)
    End If
End Sub

Private Sub ReplaceNodeName(oDoc As DOMDocument, oElement As IXMLDOMElement, newName As String)
        Dim ohElement As IXMLDOMElement
        Dim sElement As IXMLDOMElement
        Dim oChild As IXMLDOMNode

        ' search the children '
        If Not oElement Is Nothing Then
                Set ohElement = oElement.parentNode
                Set sElement = oDoc.createElement(newName)

                For Each oChild In oElement.childNodes
                        Call sElement.appendChild(oChild)
                Next

                Call ohElement.replaceChild(sElement, oElement)
        End If
End Sub

问题:起初我没有意识到我不能通过执行 node.nodeName = "newName"来更改节点的名称 我实际上在 StackOverflow 上找到了一个解决方案:Change NodeName of an XML tag element using MSXML

所以我评论了我重命名节点的尝试，并尝试了使用 ReplaceNodeName 方法的版本。

实际问题:来自 createXMLpart2 的 node.appendChild (newNode) 给我一个问题:它表示变量“newNode”未设置。 我很困惑。

最佳答案

也许是这样的……

Sub Tester()

Dim r As Range
Dim xmlDoc As New MSXML2.DOMDocument
Dim xmlNodeP As MSXML2.IXMLDOMNode
Dim xmlNodeTmp As MSXML2.IXMLDOMNode
Dim bDone As Boolean

    Set r = ActiveSheet.Range("A1")

    Do While Not r Is Nothing

        Set xmlNodeTmp = xmlDoc.createElement(r.Value)
        If Len(r.Offset(0, 1).Value) > 0 Then
            xmlNodeTmp.appendChild xmlDoc.createTextNode(r.Offset(0, 1).Value)
        End If

        If Not xmlNodeP Is Nothing Then
            xmlNodeP.appendChild xmlNodeTmp
        Else
            xmlDoc.appendChild xmlNodeTmp
        End If
        Set xmlNodeP = xmlNodeTmp

        If Len(r.Offset(1, 0).Value) > 0 Then
            Set r = r.Offset(1, 0) 'sibling node
            Set xmlNodeP = xmlNodeP.ParentNode
        ElseIf Len(r.Offset(1, 1).Value) > 0 Then
            Set r = r.Offset(1, 1) 'child node
        Else
            Set r = r.Offset(1, 0)
            Set xmlNodeP = xmlNodeP.ParentNode
            Do While Len(r.Value) = 0
                If r.Column > 1 Then
                    Set r = r.Offset(0, -1)
                    Set xmlNodeP = xmlNodeP.ParentNode
                Else
                    Set r = Nothing
                    Exit Do
                End If
            Loop
        End If

    Loop
    Debug.Print xmlDoc.XML
End Sub

关于xml - 通过缩进从 XLS 单元格创建 XML 文件，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/6048508/