VBA 生成XML(转)
需要引用连个库,Microsoft ADO Ext. 6.0 for DDL and Security, Miscrosoft ActiveX Data Objects 2.7 Library .
Sub 按钮2_Click() Dim xmlFile As String xmlFile = "D:\test\books.xml" CreateXml xmlFile End Sub Function CreateXml(xmlFile As String) Dim xDoc As Object Dim rootNode As Object Dim header As Object Dim newNode As Object Dim tNode As Object Set xDoc = CreateObject("MSXML2.DOMDocument") Set rootNode = xDoc.createElement("BookList") Set xDoc.DocumentElement = rootNode 'xDoc.Load xmlFile Set header = xDoc.createProcessingInstruction("xml", "version='1.0' encoding='Unicode'") xDoc.InsertBefore header, xDoc.ChildNodes(0) Set newNode = xDoc.createElement("book") Set tNode = xDoc.DocumentElement.appendChild(newNode) tNode.setAttribute "type", "program" Set newNode = xDoc.createElement("name") Set tNode = xDoc.DocumentElement.ChildNodes.Item(0).appendChild(newNode) tNode.appendChild (xDoc.createTextNode("Thinking in Java")) Set newNode = xDoc.createElement("author") Set tNode = xDoc.DocumentElement.ChildNodes.Item(0).appendChild(newNode) tNode.appendChild (xDoc.createTextNode("Bruce Eckel")) Set newNode = xDoc.createElement("book") Set tNode = xDoc.DocumentElement.appendChild(newNode) tNode.setAttribute "type", "literature" Set newNode = xDoc.createElement("name") Set tNode = xDoc.DocumentElement.ChildNodes.Item(1).appendChild(newNode) tNode.appendChild (xDoc.createTextNode("边城")) Set newNode = xDoc.createElement("author") Set tNode = xDoc.DocumentElement.ChildNodes.Item(1).appendChild(newNode) tNode.appendChild (xDoc.createTextNode("沈从文")) Set newNode = Nothing Set tNode = Nothing Dim xmlStr As String xmlStr = PrettyPrintXml(xDoc) WriteUtf8WithoutBom xmlFile, xmlStr Set rootNode = Nothing Set xDoc = Nothing MsgBox xmlFile & "输出完成" End Function '格式化xml,带换行缩进 Function PrettyPrintXml(xmldoc) As String Dim reader As Object Dim writer As Object Set reader = CreateObject("Msxml2.SAXXMLReader.6.0") Set writer = CreateObject("Msxml2.MXXMLWriter.6.0") writer.indent = True writer.omitXMLDeclaration = True reader.contentHandler = writer reader.Parse (xmldoc) PrettyPrintXml = writer.Output End Function ' utf8无BOM编码格式 Function WriteUtf8WithoutBom(filename As String, content As String) Dim stream As New ADODB.stream stream.Open stream.Type = adTypeText stream.Charset = "utf-8" stream.WriteText "<?xml version=" & Chr(34) & "1.0" & Chr(34) & _ " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>" & vbCrLf stream.WriteText content '移除前三个字节(0xEF,0xBB,0xBF) stream.Position = 3 Dim newStream As New ADODB.stream newStream.Type = adTypeBinary newStream.Mode = adModeReadWrite newStream.Open stream.CopyTo newStream stream.Flush stream.Close newStream.SaveToFile filename, adSaveCreateOverWrite newStream.Flush newStream.Close End Function --------------------- 作者:luwhite 来源:CSDN 原文:https://blog.csdn.net/luwhite/article/details/52343305 版权声明:本文为博主原创文章,转载请附上博文链接!