Creating each row of excel data into xml files using VBA Macro

Question

I am trying to create each row (Specific Columns) of Excel data into xml files (with tags) using VBA Macro. I am able to create the files but data is not populating into xml files. Please help me!!

Option Explicit Private Sub SaveAs_XML() On Error GoTo ErrHandle Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60 Dim root As IXMLDOMElement, dataNode As IXMLDOMElement, lastnameNode As IXMLDOMElement, AgeNode As IXMLDOMElement Dim dataNameAttrib As IXMLDOMAttribute, Attrib As IXMLDOMAttribute Dim nameAttrib As IXMLDOMAttribute, lastnameAttrib As IXMLDOMAttribute, AgeAttrib As IXMLDOMAttribute Dim i As Long Dim Folder As String Dim WS_Src As Worksheet, rng As Range, C As Range, d As Range Dim fs, f, ts, s Dim XDoc Folder = "\C:\New folder\" Set WS_Src = ThisWorkbook.Worksheets("data") Set rng = WS_Src.Range("B1", WS_Src.Range("B" & Rows.Count).End(xlUp)) For Each C In rng Set fs = CreateObject("Scripting.FileSystemObject") fs.CreateTextFile Folder & C.Value & ".xml" Set f = fs.GetFile(Folder & C.Value & ".xml") Next Set XDoc = CreateObject("MSXML2.DOMDocument") ' DECLARE XML DOC OBJECT ' Set root = doc.createElement("list") doc.appendChild root ' WRITE TO XML ' For i = 2 To Sheets(1).UsedRange.Rows.Count ' DATA NODE ' Set dataNode = doc.createElement("data") root.appendChild dataNode ' NAME ATTRIBUTE ' Set dataNameAttrib = doc.createAttribute("name") dataNameAttrib.Value = Range("B" & i) dataNode.setAttributeNode dataNameAttrib ' LASTNAME ATTRIBUTE ' Set lastnameAttrib = doc.createAttribute("lastname") lastnameAttrib.Value = Range("C" & i) lastnameNode.setAttributeNode lastnameAttrib ' AGE ATTRIBUTE ' Set AgeAttrib = doc.createAttribute("age") AgeAttrib.Value = Range("E" & i) AgeNode.setAttributeNode AgeAttrib Next i ' PRETTY PRINT RAW OUTPUT ' xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _ & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _ & " xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _ & "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _ & "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _ & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _ & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _ & " <xsl:copy>" _ & " <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _ & " </xsl:copy>" _ & " </xsl:template>" _ & "</xsl:stylesheet>" xslDoc.async = False MsgBox "Successfully exported Excel data to XML!", vbInformation Exit Sub ErrHandle: MsgBox Err.Number & " - " & Err.Description, vbCritical Exit Sub End Sub

I want output to be something like this (xml file) for each row

$ Output <?xml version="1.0" encoding="UTF-8"?> <List> <Data name="test1" lastname="lastname1" age ="24" /> </List>

You're creating the xml but then you don't save it anywhere? What's the purpose of the file creation prior to the XML loop? And what do you mean to do with the xsl document? — Tim Williams
– Tim Williams, Commented Sep 1, 2017 at 0:10

Tim Williams · Accepted Answer · 2017-09-03 21:03:11Z

This should do what you need. No xsl, but that doesn't matter.

Your question seems to have code sections which are somewhat disconnected from each other, so I made a few guesses about what exactly you're wanting to do.

Private Sub SaveAs_XML() Dim doc As MSXML2.DOMDocument60, pi Dim root As IXMLDOMElement, dataNode As IXMLDOMElement Dim i As Long For i = 2 To Sheets(1).UsedRange.Rows.Count Set doc = New MSXML2.DOMDocument60 Set root = doc.createElement("list") doc.appendChild root Set dataNode = doc.createElement("data") root.appendChild dataNode AddAttributeWithValue dataNode, "name", Range("B" & i) AddAttributeWithValue dataNode, "lastname", Range("C" & i) AddAttributeWithValue dataNode, "age", Range("E" & i) Set pi = doc.createProcessingInstruction("xml", "version=""1.0""") doc.InsertBefore pi, doc.ChildNodes.Item(0) doc.Save "C:\_Stuff\xml\" & Range("B" & i).Value & ".xml" Next i MsgBox "Successfully exported Excel data to XML!", vbInformation End Sub 'utility: add an attribute (with a value) to an element Sub AddAttributeWithValue(el As IXMLDOMElement, attName, attValue) Dim att Set att = el.OwnerDocument.createAttribute(attName) att.Value = attValue el.setAttributeNode att End Sub

Thanks a lot. This worked very well. I have one more question. How can I save each file name with data in the name column for each row?

Collectives™ on Stack Overflow

Creating each row of excel data into xml files using VBA Macro

1 Answer 1

2 Comments

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Linked

Related