VBA编写Ribbon Custom UI编辑器06——读取xml

Private Const CUSTOMUI_NAME As String = "customUI/customUI.xml"

'从ZIP文件中读取customUI.xml
Sub ReadCustomUI()
    If VBA.Len(FileName) = 0 Then
        FileName = SelectFile()
        If VBA.Len(FileName) = 0 Then Exit Sub
    End If
    
    Dim zip As CPKZip
    Set zip = NewCPKZip()
    
    Dim ret As String
    ret = zip.Parse(FileName)
    If VBA.Len(ret) Then
        MsgBox ret
        Exit Sub
    End If
    
    Dim b() As Byte
    Dim bucs2() As Byte
    Dim sXML As String
    
    '尝试读取文件中的customUI.xml
    ret = zip.UnZipFile(CUSTOMUI_NAME, b)
    If ret = "zip: ZIP文件中不存在的文件:customUI/customUI.xml" Then
        '不存在的时候插入一个默认模板
        If MsgBox("文件中没有customUI.xml，是否插入一个模板？", vbYesNo) = vbYes Then
            sXML = "<customUI xmlns=""http://schemas.microsoft.com/office/2006/01/customui""  onLoad=""RibbonUI_onLoad"">" & _
                   "<ribbon>" & _
                    "<tabs>" & _
                    "  <tab id=""TabID"" label=""tabName"" insertAfterMso=""TabDeveloper"">" & _
                    "    <group id=""GroupID"" label=""GroupName"">" & _
                    "      <button id=""Button1"" label=""buttonname&#13;"" size=""large"" onAction=""Macro"" imageMso=""HappyFace"" />" & _
                    "    </group>" & _
                    "  </tab>" & _
                    "</tabs>" & _
                    "</ribbon>" & _
                    "</customUI>"
            
        Else
            Exit Sub
        End If
    Else
        '将读取到customUI.xml Byte数组，编码UTF8转换为UCS2
        ret = FromUTF8(b, bucs2)
        If VBA.Len(ret) Then
            MsgBox "编码转换出错：" & vbNewLine & ret
            Exit Sub
        End If
        
        sXML = bucs2
    End If
    
    Dim x As CXML
    Set x = NewCXML()
    Dim tXML As xml
    '解析XML文本到XML结构体
    ret = x.Decode(sXML, tXML)
    If VBA.Len(ret) Then
        MsgBox ret
        Exit Sub
    End If
    
    Dim arr() As String
    Cells.Clear
    arr = XML2Array(tXML)
    Range("A1").Resize(UBound(arr, 1) - LBound(arr, 1) + 1, UBound(arr, 2) - LBound(arr, 2) + 1).Value = arr  '不用-1因为0是root，正好作为标题
    
    Set x = Nothing
    Set zip = Nothing
End Sub