macrosVBA Excel创buildXML文件date
与Excel中的macrosVBA我需要在Excel文件中的1张转换date。 为此，我已经创build了一个脚本，但我有问题要正确生成XML中的date我需要第一行标题，然后公式读取数据的所有行。
Sub createXML() Sheets("Sheet1").Select FullPath = baseDirectory & projectName & "\xmlBatch\inputTest.xml" Set objStream = CreateObject("ADODB.Stream") objStream.Charset = "iso-8859-1" objStream.Open objStream.WriteText ("<?xml version='1.0' encoding='UTF-8'?>" & vbLf) objStream.WriteText ("<y:input xmlns:y='http://www.test.com/engine/3'>" & vbLf) objStream.WriteText (" <y:datas>" & vbLf) objStream.WriteText (" <y:instance yid='theGeneralData'>" & vbLf) objStream.WriteText ("" & vbLf) objStream.WriteText ("<language yid='LANG_en' />" & vbLf) objStream.WriteText ("<client yclass='Client'>" & vbLf) objStream.WriteText (" <firstName>" & Cells(1, 1).Text & "</firstName>" & vbLf) objStream.WriteText (" <lastName>" & Cells(1, 2).Text & "</lastName>" & vbLf) objStream.WriteText (" <age>" & Cells(1, 3).Text & "</age>" & vbLf) objStream.WriteText (" <civility yid='" & toYID(Cells(1, 4).Text) & "' />" & vbLf) objStream.WriteText ("</client>" & vbLf) objStream.WriteText ("" & vbLf) objStream.WriteText (" </y:instance>" & vbLf) objStream.WriteText (" </y:datas>" & vbLf) objStream.WriteText ("</y:input>" & vbLf) objStream.SaveToFile FullPath, 2 objStream.Close End Sub Excel数据现在是这种格式：
在这里input图像说明
但是我现在的输出是这样的：
> <?xml version='1.0' encoding='UTF-8'?> <y:input xmlns:y='http://www.test.com/engine/3'> <y:datas> <y:instance yid='theGeneralData'> <language yid='LANG_en' /> <client yclass='Client'> <firstName>firstName</firstName> <lastName>lastName</lastName> <age>age</age> <civility yid='CIVILITY' /> </client> </y:instance> </y:datas> </y:input>
我们需要有这个输出：
> <?xml version='1.0' encoding='UTF-8'?> <y:input xmlns:y='http://www.test.com/engine/3'> <y:datas> <y:instance yid='theGeneralData'> <language yid='LANG_en' /> <client yclass='Client'> <firstName>1</firstName> <lastName>1</lastName> <age>1</age> <civility yid='CIVILITY' /> </client> <client yclass='Client'> <firstName>2</firstName> <lastName>2</lastName> <age>2</age> <civility yid='CIVILITY' /> </client> <client yclass='Client'> <firstName>3</firstName> <lastName>3</lastName> <age>3</age> <civility yid='CIVILITY' /> </client> </y:instance> </y:datas> </y:input>
考虑使用MSXML ，这是一个全面的符合W3C标准的XML API库，您可以使用它来构build具有DOM属性（ createElement ， setAttribute ）的XML，而不是串联文本string。 XML不是一个文本文件，而是一个带有编码和树结构的标记文件。 VBA配备了MSXML对象，可以从Excel数据迭代构build树，如下所示：
Excel数据
FirstName LastName Age Civility Aaron Adams 45 CIVILITY Beatrice Beaumont 39 CIVILITY Clark Chandler 28 CIVILITY Debra Devins 31 CIVILITY Eric Easterlin 42 CIVILITY
VBAmacros（构buildXML树，然后用XSLT打印）
Sub xmlExport() On Error GoTo ErrHandle ' ADD Microsoft XML, v6.0 IN VBA References Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60 Dim root As IXMLDOMNode, ydatasNode As IXMLDOMNode, yinstanceNode As IXMLDOMNode, languageNode As IXMLDOMElement Dim yinstanceAttrib As IXMLDOMAttribute, languageAttrib As IXMLDOMAttribute Dim clientNode As IXMLDOMElement, civilityNode As IXMLDOMElement Dim firstNameNode As IXMLDOMElement, lastNameNode As IXMLDOMElement, ageNode As IXMLDOMElement Dim clientAttrib As IXMLDOMAttribute, civilityAttrib As IXMLDOMAttribute Dim nmsp As String Dim i As Long ' DECLARE ROOT AND CHILDREN ' nmsp = "http://www.test.com/engine/3" Set root = doc.createNode(NODE_ELEMENT, "y:input", nmsp) doc.appendChild root Set ydatasNode = doc.createNode(NODE_ELEMENT, "y:datas", nmsp) root.appendChild ydatasNode Set yinstanceNode = doc.createNode(NODE_ELEMENT, "y:instance", nmsp) ydatasNode.appendChild yinstanceNode Set yinstanceAttrib = doc.createAttribute("yid") yinstanceAttrib.Value = "theGeneralData" yinstanceNode.Attributes.setNamedItem yinstanceAttrib Set languageNode = doc.createElement("language") yinstanceNode.appendChild languageNode Set languageAttrib = doc.createAttribute("yid") languageAttrib.Value = "LANG_en" languageNode.setAttributeNode languageAttrib ' ITERATE CLIENT NODES ' For i = 2 To Sheets(1).UsedRange.Rows.Count ' CLIENT NODE ' Set clientNode = doc.createElement("client") yinstanceNode.appendChild clientNode Set clientAttrib = doc.createAttribute("yclass") clientAttrib.Value = "Client" clientNode.setAttributeNode clientAttrib ' FIRST NAME NODE ' Set firstNameNode = doc.createElement("firstName") firstNameNode.Text = Range("A" & i) clientNode.appendChild firstNameNode ' LAST NAME NODE ' Set lastNameNode = doc.createElement("lastName") lastNameNode.Text = Range("B" & i) clientNode.appendChild lastNameNode ' AGE NODE ' Set ageNode = doc.createElement("age") ageNode.Text = Range("C" & i) clientNode.appendChild ageNode ' CIVILITY NODE ' Set civilityNode = doc.createElement("civility") clientNode.appendChild civilityNode Set civilityAttrib = doc.createAttribute("yid") civilityAttrib.Value = toYID(Range("D" & i)) civilityNode.setAttributeNode civilityAttrib 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 doc.transformNodeToObject xslDoc, newDoc newDoc.Save baseDirectory & projectName & "\xmlBatch\inputTest.xml" MsgBox "Successfully exported Excel data to XML!", vbInformation Exit Sub ErrHandle: MsgBox Err.Number & " - " & Err.Description, vbCritical Exit Sub End Sub
产量
<?xml version="1.0" encoding="UTF-8"?> <y:input xmlns:y="http://www.test.com/engine/3"> <y:datas> <y:instance yid="theGeneralData"> <language yid="LANG_en"></language> <client yclass="Client"> <firstName>Aaron</firstName> <lastName>Adams</lastName> <age>45</age> <civility yid="CIVILITY"></civility> </client> <client yclass="Client"> <firstName>Beatrice</firstName> <lastName>Beaumont</lastName> <age>39</age> <civility yid="CIVILITY"></civility> </client> <client yclass="Client"> <firstName>Clark</firstName> <lastName>Chandler</lastName> <age>28</age> <civility yid="CIVILITY"></civility> </client> <client yclass="Client"> <firstName>Debra</firstName> <lastName>Devins</lastName> <age>31</age> <civility yid="CIVILITY"></civility> </client> <client yclass="Client"> <firstName>Eric</firstName> <lastName>Easterlin</lastName> <age>42</age> <civility yid="CIVILITY"></civility> </client> </y:instance> </y:datas> </y:input>
你有你的代码设置的方式，它只是看第一行。 你需要添加一个循环来查看所有的行（我假设你有'n'行数）。 要做到这一点，你可以通过使用类似的东西来获得行数：
Dim intTotalRows as Integer : intTotalRows = Worksheets("<your worksheet name>").Cells(Rows.Count, "B").End(xlUp).Row
现在你已经有了行数，在objStream.WriteText ("<client yclass='Client'>" & vbLf)之前添加一个FOR循环，并在objStream.WriteText ("</client>" & vbLf) 。 这将遍历所有的行。 你的FOR循环可能看起来像这样：
For intRow = 1 To intTotalRows
现在用intRow改变你的行号。 即：
objStream.WriteText (" <firstName>" & Cells(intRow, 1).Text & "</firstName>" & vbLf) objStream.WriteText (" <lastName>" & Cells(intRow, 2).Text & "</lastName>" & vbLf)
希望这可以帮助
这里的输出
<?xml version='1.0' encoding='UTF-8'?> <y:input xmlns:y='http://www.test.com/engine/3'> <y:datas> <y:instance yid='theGeneralData'> <language yid='LANG_en' /> <client yclass='Client'> <firstName>firstName</firstName> <lastName>lastName</lastName> <age>age</age> <civility yid='CIVILITY' /> </client> <language yid='LANG_en' /> <client yclass='Client'> <firstName>firstName</firstName> <lastName>lastName</lastName> <age>age</age> <civility yid='CIVILITY' /> </client> <language yid='LANG_en' /> <client yclass='Client'> <firstName>firstName</firstName> <lastName>lastName</lastName> <age>age</age> <civility yid='CIVILITY' /> </client> <language yid='LANG_en' /> <client yclass='Client'> <firstName>firstName</firstName> <lastName>lastName</lastName> <age>age</age> <civility yid='CIVILITY' /> </client> </y:instance> </y:datas> </y:input>
在这里我的脚本：
Sub createXML() Sheets("Sheet1").Select FullPath = baseDirectory & projectName & "\xmlBatch\inputTest.xml" Set objStream = CreateObject("ADODB.Stream") objStream.Charset = "iso-8859-1" objStream.Open objStream.WriteText ("<?xml version='1.0' encoding='UTF-8'?>" & vbLf) objStream.WriteText ("<y:input xmlns:y='http://www.test.com/engine/3'>" & vbLf) objStream.WriteText (" <y:datas>" & vbLf) objStream.WriteText (" <y:instance yid='theGeneralData'>" & vbLf) objStream.WriteText ("" & vbLf) objStream.WriteText ("<language yid='LANG_en' />" & vbLf) Dim intTotalRows As Integer: intTotalRows = Worksheets("Sheet1").Cells(Rows.Count, "B").End(x1Up).Row For intRow = 1 To intTotalRows objStream.WriteText ("<client yclass='Client'>" & vbLf) objStream.WriteText (" <firstName>" & Cells(1).Text & "</firstName>" & vbLf) objStream.WriteText (" <lastName>" & Cells(2).Text & "</lastName>" & vbLf) objStream.WriteText (" <age>" & Cells(3).Text & "</age>" & vbLf) objStream.WriteText (" <civility yid='" & toYID(Cells(4).Text) & "' />" & vbLf) objStream.WriteText ("</client>" & vbLf) Next intRow objStream.WriteText ("" & vbLf) objStream.WriteText (" </y:instance>" & vbLf) objStream.WriteText (" </y:datas>" & vbLf) objStream.WriteText ("</y:input>" & vbLf) objStream.SaveToFile FullPath, 2 objStream.Close End Sub
非常感谢