VBA 出力EXCLE的数据成xml （带层次关系）

Public Sub Workbook_BeforeSave()

Dim fileName As String
Dim firstIndex As Integer
Dim lastIndex As Integer
Dim rootNodeName As String
Dim xmlDoc As MSXML2.DOMDocument

fileName = Worksheets(2).Range("B8").Value
firstIndex = Worksheets(2).Range("B10").Value
lastIndex = Worksheets(2).Range("B11").Value
rootNodeName = Worksheets(2).Range("B12").Value

If fileName = "" Then
MsgBox ("僼傽僀儖僷僗傪巜掕偔偩偝偄丅")
Exit Sub
End If

Set xmlDoc = New MSXML2.DOMDocument

Set rootNode = xmlDoc.createElement(rootNodeName)
Set xmlDoc.DocumentElement = rootNode
Set Header = xmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
xmlDoc.InsertBefore Header, xmlDoc.ChildNodes(0)

xmlDoc.Save fileName
Set xmlDoc = Nothing

Call OutputSchema(fileName, firstIndex, lastIndex)

End Sub

Public Sub OutputSchema(fileName, firstIndex, lastIndex)
Dim caseIndex As Integer
Dim pmstartIndex As Integer

'case僨乕僞start
caseIndex = Worksheets(1).Range("IV1").End(xlToLeft).Column

'僷儔儊乕僞楍栚傪庢摼
For i = 1 To caseIndex
cellValue = Worksheets(1).Cells(1, i).Value
If cellValue = "pmstart" Then
pmstartIndex = i
Exit For
End If
Next

Dim nodeIndex As Integer
Dim xmlNode(100) As IXMLDOMElement '梫慺

Set xmlDoc = New MSXML2.DOMDocument
xmlDoc.Load fileName

Set Root = xmlDoc.DocumentElement
Set xmlNode(1) = Root
For nodeIndex = firstIndex To lastIndex
nodeName = Worksheets(1).Cells(nodeIndex, pmstartIndex).Value
attrValue = Worksheets(1).Cells(nodeIndex, pmstartIndex + 1).Value
caseValue = Worksheets(1).Cells(nodeIndex, pmstartIndex + 2).Value

For j = 2 To pmstartIndex
PmName = Worksheets(1).Cells(nodeIndex, j).Value
nextPmName = Worksheets(1).Cells(nodeIndex + 1, j + 1).Value
If Not PmName = "" Then
Set xmlNode(j) = xmlNode(j - 1).appendChild(xmlDoc.createElement(nodeName))
If Not attrValue = "" Then
Set xmlAttr = xmlNode(j).Attributes.setNamedItem(xmlDoc.createAttribute("nameSpace"))
xmlAttr.nodeValue = attrValue
End If
If nextPmName = "" Or j = pmstartIndex - 1 Then
xmlNode(j).Text = caseValue & vbCrLf
End If

Exit For
End If
Next
Next
xmlDoc.Save fileName
Set xmlDoc = Nothing
End Sub