vba xml转成html,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:estooks.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

来源：优快云

原文：https://blog.youkuaiyun.com/luwhite/article/details/52343305

版权声明：本文为博主原创文章，转载请附上博文链接！