View Full Version : From Excel to XML via VBA
makikivi
06-22-2010, 05:43 AM
Hello,
I am trying to get an XML out of an excel 2007 file using VBA code. I wanted to attach the file but I cannot because I dont have 5 thread posts so far :). What it does is, it converts the table into a row-column structure in XML. And as a result I get the following:
<?xml version="1.0" ?>
<data>
<one>
<row>
<column>Raymond</column>
<column>11</column>
<column>59</column>
</row>
</one>
<one>
<row>
<column>Moon</column>
<column>7456</column>
<column>58</column>
</row>
However, I need each of the rows to have its own name attribute, like the following:
<?xml version="1.0" ?>
<data>
<one name="Proj1">
<row>
<column>Raymond</column>
<column>11</column>
<column>59</column>
</row>
</one>
<one name="Proj2">
<row>
<column>Moon</column>
<column>7456</column>
<column>58</column>
</row>
Can someone help me in resolving this small issue? If you want the code please give me your e-mail and I will send it to you. THANK YOU
Bob Phillips
06-22-2010, 08:27 AM
We might be able to help resolve the issue if we had any idea what the issue was.
makikivi
06-23-2010, 02:18 AM
Well, the code that I have produces this as a result:
<?xml version="1.0" ?>
<data>
<one>
<row>
<column>Raymond</column>
<column>11</column>
<column>59</column>
</row>
</one>
<one>
<row>
<column>Moon</column>
<column>7456</column>
<column>58</column>
</row>
And I want to adjust the code so I can get this as a result:
<?xml version="1.0" ?>
<data>
<one name="Proj1">
<row>
<column>Raymond</column>
<column>11</column>
<column>59</column>
</row>
</one>
<one name="Proj2">
<row>
<column>Moon</column>
<column>7456</column>
<column>58</column>
</row>
And this is the code that I use:
Function GenerateXMLDOM(rngData As Range, rootNodeName As String)
Const NODE_DELIMITER As String = "/" ' the default node delimiter
Dim intColCount As Integer
Dim intRowCount As Integer
Dim intColCounter As Integer
Dim intRowCounter As Integer
Dim rngCell As Range
' Create the XML DOM object
Set ObjXMLDoc = CreateObject("Microsoft.XMLDOM")
ObjXMLDoc.async = False
Set Heading = ObjXMLDoc.createNode(7, "xml", "")
ObjXMLDoc.appendChild (Heading)
' Set the root node
Set top_node = ObjXMLDoc.createNode(1, rootNodeName, "")
ObjXMLDoc.appendChild (top_node)
Dim Nodes() As String 'Array storing the current splited node names
Dim NodeStack() As String 'Array storing the last node names
Dim new_nodes()
ReDim NodeStack(0)
ReDim new_nodes(0)
With rngData ' The selected region on the Excel Sheet passed in
' Discover dimensions of the data we will be dealing with...
intColCount = .Columns.Count
intRowCount = .Rows.Count
Dim strColNames() As String ' The Array of column names
ReDim strColNames(intColCount)
' First Row is the Field/Tag names
' Extract all the field names into array "strColNames"
If intRowCount >= 1 Then
' Loop accross columns... and put names in array
For intColCounter = 1 To intColCount
' Mark the cell under current scrutiny by setting
' an object variable...
Set rngCell = .Cells(1, intColCounter)
' not support merged cells .. so quit
If Not rngCell.MergeArea.Address = _
rngCell.Address Then
MsgBox ("!! Cell Merged ... Invalid format")
Exit Function
End If
strColNames(intColCounter) = rngCell.Text
Next
End If
' Loop down the table's rows
For intRowCounter = 2 To intRowCount
ReDim new_nodes(0)
ReDim NodeStack(0)
' Loop accross columns...
For intColCounter = 1 To intColCount
' Mark the cell under current scrutiny by setting
' an object variable...
Set rngCell = .Cells(intRowCounter, intColCounter)
' Is the cell merged?..
If Not rngCell.MergeArea.Address = _
rngCell.Address Then
MsgBox ("!! Cell Merged ... Invalid format")
Exit Function
End If
' divide the field name by the delimiter to get appropriate node names
Nodes = Split(strColNames(intColCounter), NODE_DELIMITER)
If UBound(Nodes) = 0 Then
ReDim Nodes(1)
Nodes(1) = strColNames(intColCounter)
End If
' don't count it when no content
If Trim(rngCell.Text) <> "" Then
Dim i As Integer
MatchAll = True
For i = 1 To UBound(Nodes)
If i <= UBound(NodeStack) Then
If Trim(Nodes(i)) <> Trim(NodeStack(i)) Then
'not match
MatchAll = False
Exit For
End If
Else
MatchAll = False
Exit For
End If
Next
' match all means in same level as previous, so it needs to output for the last node
If MatchAll Then
i = i - 1
End If
If UBound(new_nodes) < UBound(Nodes) Then
' enlong the array
ReDim Preserve new_nodes(UBound(Nodes))
End If
For t = i To UBound(Nodes)
' create uncommon nodes with the previous one
Set new_nodes(t) = ObjXMLDoc.createNode(1, Nodes(t), "")
Next
For t = i - 1 To UBound(Nodes) - 1
If t >= 1 Then
' connect the nodes based on the hierarchy
new_nodes(t).appendChild (new_nodes(t + 1))
End If
Next
Set Textcont = ObjXMLDoc.createTextNode(Trim(rngCell.Text))
new_nodes(UBound(Nodes)).appendChild (Textcont)
If i = 1 Then
top_node.appendChild (new_nodes(1))
End If
NodeStack = Nodes
End If
Next ' finished a column
Next
End With
' Return the XMLDOM
Set GenerateXMLDOM = ObjXMLDoc
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.