VBA 格式化输出XML(UTF-8无BOM编码)
2016-08-28 02:37
483 查看
VBA可以使用MSXML2.Document来创建XML Dom树并输出到文件,先看个简单的例子:
在宏工程中调用一下这个函数工程,就可以生成一个xml文件,但是生成的xml文件所有内容都显示在一行上了,有没有方法进行换行及缩进,让xml文件看起来更整齐美观呢?方法是有的,借助Msxml2.SAXXMLReader和Msxml2.MXXMLWriter就可以实现这个效果,看代码:
然后将前面的xDoc.save xmlFile改一下:
这样就可以格式化输出xml文件了。还有一个问题,我们想要指定xml文件的编码格式,如UTF-8,GB2312等,我通常习惯保存成UTF-8格式,那么该如何设置呢?查找资料,可以用ADODB.stream来搞。
细心点的话会发现用上面的方法实际上输出的文件格式是带BOM的UTF-8,它跟UTF-8无BOM的区别在哪呢?用UltraEdit工具来看十六进制码,会发现前者在开头多了三个字节:0xEF,0xBB,0xBF,想保存成UTF-8无BOM,把这三个字节去掉不就行了,实现如下:
注意需要引用两个库:Microsoft ADO Ext. 6.0 for DDL and Security,Microsoft ActiveX Data Objects 2.7 Library
最后附上完整代码:
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 xDoc.save xmlFile End Function
在宏工程中调用一下这个函数工程,就可以生成一个xml文件,但是生成的xml文件所有内容都显示在一行上了,有没有方法进行换行及缩进,让xml文件看起来更整齐美观呢?方法是有的,借助Msxml2.SAXXMLReader和Msxml2.MXXMLWriter就可以实现这个效果,看代码:
'格式化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
然后将前面的xDoc.save xmlFile改一下:
'xDoc.save xmlFile Dim xmlStr As String xmlStr = PrettyPrintXml(xDoc) WriteUtf8WithoutBom xmlFile, xmlStr Open xmlFile For Output As #1 Print #1, xmlStr Close #1
这样就可以格式化输出xml文件了。还有一个问题,我们想要指定xml文件的编码格式,如UTF-8,GB2312等,我通常习惯保存成UTF-8格式,那么该如何设置呢?查找资料,可以用ADODB.stream来搞。
Function WriteWithUtf8(filename As String, content As String) Dim stream As New ADODB.stream stream.Open stream.Type = adTypeText stream.Charset = "utf-8" stream.WriteText content stream.SaveToFile filename, adSaveCreateOverWrite stream.Flush stream.Close End Function
细心点的话会发现用上面的方法实际上输出的文件格式是带BOM的UTF-8,它跟UTF-8无BOM的区别在哪呢?用UltraEdit工具来看十六进制码,会发现前者在开头多了三个字节:0xEF,0xBB,0xBF,想保存成UTF-8无BOM,把这三个字节去掉不就行了,实现如下:
' 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) & afbf amp; "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
注意需要引用两个库:Microsoft ADO Ext. 6.0 for DDL and Security,Microsoft 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
相关文章推荐
- Outlook 批量发送邮件
- XML 与 JSON 优劣对比
- VBA将excel数据表生成JSON文件
- excel vba 限制工作表的滚动区域代码
- VBA解决Windows空当接龙的617局
- excel vba 高亮显示当前行代码
- As3.0 xml + Loader应用代码
- 网马生成器 MS Internet Explorer XML Parsing Buffer Overflow Exploit (vista) 0day
- ext读取两种结构的xml的代码
- 实例解析Ruby程序中调用REXML来解析XML格式数据的用法
- Ruby中XML格式数据处理库REXML的使用方法指南
- C#实现导出List数据到xml文件的方法【附demo源码下载】
- Flex中对表格某列的值进行数字格式化并求百分比添加%
- C#中如何使用 XmlReader 读取XML文件
- C#针对xml基本操作及保存配置文件应用实例
- Ruby使用REXML库来解析xml格式数据的方法
- Ruby程序中创建和解析XML文件的方法
- Ruby的XML格式数据解析库Nokogiri的使用进阶
- asp格式化日期时间格式的代码