同时还需要一个相反的函数,Excel单元格数据转换为XML结构体。
01
XML结构体转换为二维数组
Public Function XML2Array(tXML As XML) As String()
Dim arr() As String
Dim pcol As Long
'记录属性所在的列
Dim h As CHash
'注意:这里应该先遍历一次,获取所有不重复属性名称的个数的
Set h = NewCHash(200)
h.Add "XMLName", 0
h.Add "HasChild", 1
Dim i As Long, j As Long
'计算列的数量
'第0个是不存在的根节点
For i = 0 + 1 To tXML.nNode - 1
For j = 0 To tXML.Nodes(i).AttriNum - 1
If Not h.Exists(tXML.Nodes(i).Attris(j).Key) Then
h.Add tXML.Nodes(i).Attris(j).Key, h.Count
End If
Next
Next
ReDim arr(tXML.nNode, h.Count - 1) As String
arr(0, 0) = "xmlItem"
arr(0, 1) = "HasChild"
'开始转换
For i = 0 + 1 To tXML.nNode - 1
arr(i, 0) = tXML.Nodes(i).XMLItem
arr(i, 1) = VBA.CStr(tXML.Nodes(i).HasChild)
For j = 0 To tXML.Nodes(i).AttriNum - 1
pcol = VBA.CLng(h.GetItem(tXML.Nodes(i).Attris(j).Key))
arr(0, pcol) = tXML.Nodes(i).Attris(j).Key
arr(i, pcol) = tXML.Nodes(i).Attris(j).value
Next
Next
XML2Array = arr
Set h = Nothing
End Function
02
二维数组转换为XML结构体
'Arr 从Excel单元格读取的数组
Public Function Array2XMLString(arr()) As String
Dim rows As Long
Dim cols As Long
Dim result() As String
Dim value As String
Dim tmp() As String
rows = UBound(arr, 1)
cols = UBound(arr, 2)
ReDim result(rows - 1 - 1) As String '第一行是标题
ReDim tmp(cols - 1) As String '记录属性的值,HasChild在B列,是不需要的,多出的一个最后放“>”
Dim i As Long
Dim j As Long
Dim iLevel As Long
Dim bHasChild As Boolean
For i = 2 To rows
tmp(0) = "<" & VBA.CStr(arr(i, 1)) 'xmlItem
'/*这种表示的是一个具有子元素的元素的结束
If VBA.Left$(VBA.CStr(arr(i, 1)), 1) = "/" Then iLevel = iLevel - 1
'HasChild
bHasChild = VBA.CBool(arr(i, 2))
If bHasChild Then
tmp(cols - 1) = ">"
Else
If VBA.Left$(VBA.CStr(arr(i, 1)), 1) = "/" Then
tmp(cols - 1) = ">" & vbNewLine
Else
tmp(cols - 1) = "/>"
End If
End If
For j = 3 To cols
value = VBA.CStr(arr(i, j))
'不为空的时候设置属性值
If VBA.Len(value) Then
tmp(j - 2) = " " & VBA.CStr(arr(1, j)) & "=""" & value & """"
Else
tmp(j - 2) = ""
End If
Next
result(i - 2) = VBA.Space$(iLevel) & VBA.Join(tmp, "")
If bHasChild Then iLevel = iLevel + 1
Next
Array2XMLString = VBA.Join(result, vbNewLine)
End Function