VBA--XML文件的读取与输出

本文链接：https://blog.csdn.net/qq_41777527/article/details/80968241

XML的简单使其易于在任何应用程序中读写数据，这使XML很快成为数据交换的唯一公共语言，虽然不同的应用软件支持其它的数据交换格式，但不久之后他们都将支持XML，那就意味着程序可以更容易的与Windows, Mac OS, Linux以及其他平台下产生的信息结合，然后可以很容易加载XML数据到程序中并分析它，并以XML格式输出结果。下面我们来学习一下用VBA如何读取XML文件和输出XML文件

1.节点式（标签）XML文本的获取

首先我们来观察一下节点式XML文本的特点，发现它的内容都是在节点（标签）内，一本书为一个节点，每本书的特点又为一个节点，层次分明

我们要读取它的节点内容，将图书编号，书名，作者，价格，出版社等内容获取，读取后效果如下

具体代码及解释如下所示

Option Explicit
Sub 读取XML节点()
'后期绑定
'Dim xdoc As Object
'Set xdoc = CreateObject("MSXML2.DOMDocument")
'前期绑定
Dim xdoc As New DOMDocument60 '声明的同时创建XML对象
Dim b As Boolean, root As IXMLDOMElement
b = xdoc.Load(ThisWorkbook.Path & "\BookStore1.xml")
If b = True Then

Set root = xdoc.DocumentElement '获取根节点
    Dim i As Integer, j As Integer
    '获取列标题
    With root.ChildNodes(0) '根节点的子节点
         For i = 0 To .ChildNodes.Length - 1 '子节点的子节点个数
        Worksheets(1).Cells(1, i + 1) = .ChildNodes(i).nodeName
         Next i
    End With
    '获取书籍信息
    For i = 0 To root.ChildNodes.Length - 1
         With root.ChildNodes(i)
             For j = 0 To .ChildNodes.Length - 1
            Worksheets(1).Cells(i + 2, j + 1).Value = .ChildNodes(j).Text '获取文本内容
             Next j
        End With
    Next i

'    Dim rchnode As IXMLDOMElement, info As IXMLDOMElement
'    For Each rchnode In root.ChildNodes
'    For Each info In rchnode.ChildNodes
'    MsgBox info.Text
'    Next info
'    Next rchnode
   
Else
    MsgBox "加载失败，指定文件可能不存在"
End If

End Sub

2.XML属性文件的获取

最开始，还是要观察XML文件属性的特点，可以发现它的书名价格等都是以属性的形式出现

我们来看一下读取的效果

代码实现及解释如下

Option Explicit
Sub 读取属性()
Dim root As IXMLDOMElement, xdoc As New DOMDocument60
xdoc.Load ThisWorkbook.Path & "\BookStore2.xml"
Set root = xdoc.DocumentElement '获取节点
Dim i As Integer, j As Integer
With root.ChildNodes(0)
    For i = 0 To .Attributes.Length - 1
        Worksheets(3).Cells(1, i + 1).Value = .Attributes(i).nodeName
    Next i
End With
For i = 0 To root.ChildNodes.Length - 1
'MsgBox root.ChildNodes(i).Attributes.Length '节点属性
'MsgBox root.ChildNodes(i).Attributes(2).nodeName  '节点属性名称
    With root.ChildNodes(i)
        For j = 0 To .Attributes.Length - 1
            Worksheets(3).Cells(i + 2, j + 1).Value = .Attributes(j).Text
        Next j
    End With

Next i
    
End Sub

3.混合型XML文件的读取：其数据即存储在节点（标签）内，又存储在属性里

其文件样式如下图：我们可以看到它的书籍类型和ISBN 编号是用属性进行存储，而他的名称和作者及价格则是存储在节点内

读取后效果如下图所示：

代码实现及解释如下：

Option Explicit

'读取XML文件，属性，节点混合
Sub readfromxml()
Dim xmlpathname As String, arrdata() As String, xdoc As New DOMDocument60
xmlpathname = "D:\VBA学习\BookStore3.xml"
If xdoc.Load(xmlpathname) = True Then '加载成功
    Dim root As IXMLDOMElement, icols As Integer
    Dim i As Integer, j As Integer, attcount As Integer, nodecount As Integer
    Set root = xdoc.DocumentElement  '获取根节点
    With root.ChildNodes(0)
        attcount = .Attributes.Length'获取属性个数
        nodecount = .ChildNodes.Length'获取节点个数
        icols = attcount + nodecount
        ReDim arrdata(1 To 20, 1 To icols) As String
        For j = 0 To attcount - 1
        arrdata(1, j + 1) = .Attributes(j).nodeName'读取属性名称
        Next j
        For j = 0 To nodecount - 1
        arrdata(1, attcount + j + 1) = .ChildNodes(j).nodeName'读取节点名称
        Next j
    End With

    For i = 0 To root.ChildNodes.Length - 1

    With root.ChildNodes(i)
        For j = 0 To attcount - 1

        arrdata(i + 2, j + 1) = .Attributes(j).Text
        Next j
        For j = 0 To nodecount - 1
        arrdata(i + 2, attcount + j + 1) = .ChildNodes(j).Text
        Next j
        End With
        Next i
        Range("A1").Resize(root.ChildNodes.Length + 1, icols) = arrdata
        Else: MsgBox "加载失败，指定文件可能不存在", vbCritical, "失败"
        GoTo exitflag
        End If
        Set root = Nothing
       
exitflag:
        Set xdoc = Nothing
       
       
   
End Sub

4.将Excel文件输出为XML文件

具体的实现代码和解释如下

Option Explicit
Sub writetoxml()
Dim arr
arr = Range("A1").CurrentRegion
Dim xdoc As New DOMDocument60, Books As IXMLDOMElement
Set Books = xdoc.createElement("Books") '创建根节点
xdoc.appendChild Books '根节点加入到文档

Dim book As IXMLDOMElement, i As Integer, j As Integer, info As IXMLDOMElement
For i = 2 To UBound(arr, 1) '取行
    Set book = xdoc.createElement("book")
        For j = 1 To UBound(arr, 2) '取列
            'Set info = xdoc.createElement(arr(1, j))'创建节点
            'info.Text = arr(i, j)'节点文本为单元格内容
            'book.appendChild info '节点方式
       book.setAttribute arr(1, j), arr(i, j) '属性方式
        Next j
    Books.appendChild book’将book添加到Books
    
    Next i

Dim pi As IXMLDOMProcessingInstruction
Set pi = xdoc.createProcessingInstruction("xml", "version='1.0'  encoding='utf-8'")
Call xdoc.InsertBefore(pi, xdoc.ChildNodes(0))
xdoc.Save ThisWorkbook.Path & "\xmlWrite.xml"   '保存xml文档

End Sub

读取XML文件时会遇到不一样的格式，但是输出文件时我们尽量选择单一格式，这样方便读取。