通过缩进从XLS单元创建XML文件

我想要做的是通过解析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,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,Cells(i,j)

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

            'newNode.nodeValue = Cells(i,j + 1)
            createXMLpart2 xmlDoc,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

通过缩进从XLS单元创建XML文件

猜你在找的XML相关文章