VBA--XML文件的讀取與輸出



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文件時會遇到不一樣的格式，但是輸出文件時我們儘量選擇單一格式，這樣方便讀取。