[英]Creating each row of excel data into xml files using VBA Macro
I am trying to create each row (Specific Columns) of Excel data into xml files (with tags) using VBA Macro. 我正在尝试使用VBA宏将Excel数据的每一行(特定列)创建为xml文件(带有标签)。 I am able to create the files but data is not populating into xml files. 我能够创建文件,但是数据没有填充到xml文件中。 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 我希望输出的每一行都是这样的(xml文件)
$ Output
<?xml version="1.0" encoding="UTF-8"?>
<List>
<Data name="test1"
lastname="lastname1"
age ="24"
/>
</List>
This should do what you need. 这应该做您需要的。 No xsl, but that doesn't matter. 没有xsl,但这没关系。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.