VBA读取XML文件形成二维表并写入到占位符区域

Option Explicit

Sub main()
   Dim xmlfiles, i
   xmlfiles = GetXmlFiles(ThisWorkbook.path & "\Data\*.xml")
   If IsEmpty(xmlfiles) Then Exit Sub
   
   For i = LBound(xmlfiles) To UBound(xmlfiles)
        FillBlock xmlfiles(i)
   Next
   
    
End Sub


Sub FillBlock(xmlfile)
    Dim rep, shtname, blockname, arrc, rCount, cCount
    Dim wb As Workbook, sht As Worksheet, rng0 As Range
    
    Set wb = ThisWorkbook 'Excel.Application.Workbooks.Open(rep)
    
    shtname = Split(xmlfile, ".")(0)
    blockname = Split(xmlfile, ".")(1)
    
    Set sht = wb.Worksheets(shtname)
    sht.Select
    Set rng0 = sht.UsedRange.Find("{" & blockname & "}")
    
    If Not rng0 Is Nothing Then
        rng0.Select
        arrc = getContentArray(xmlfile)
        rCount = UBound(arrc, 1) - LBound(arrc, 1) + 1
        cCount = UBound(arrc, 2) - LBound(arrc, 2) + 1
        rng0.Resize(rCount, cCount) = arrc

    Else
        Debug.Print "no " & blockname
    End If
    
    Set rng0 = Nothing
    Set sht = Nothing
    'wb.Close
    Set wb = Nothing
End Sub


Function GetXmlFiles(pattern As String)
    'traverse data xml
    Dim file, arr, coll, i
    'pattern =
    file = Dir(pattern)
    
    If file = "" Then
        Exit Function
    End If
    
    Set coll = New Collection
    Do While file <> ""
        coll.Add file
        file = Dir
    Loop
     
    ReDim arr(0 To coll.Count - 1)
    For i = 0 To coll.Count - 1
        arr(i) = coll(i + 1)
    Next
    Set coll = Nothing
    GetXmlFiles = arr
End Function

Function getContentArray(xmlfile)
    Dim path, doc, fullname, root, nodes, i, j, columnsCount, rowsCount, arrTitle, arrContent

    path = ThisWorkbook.path & "\Data"
    fullname = path & "\" & xmlfile

    Set doc = CreateObject("Microsoft.XMLDOM")
    doc.Load fullname
    
    Set nodes = doc.SelectNodes("//xs:sequence/xs:element")
    columnsCount = nodes.Length
    For i = 0 To columnsCount - 1
        'Debug.Print nodes(i).getAttribute("name")
    Next
    Set nodes = Nothing

    Set root = doc.DocumentElement
    rowsCount = root.ChildNodes.Length - 1

    ReDim arrContent(0 To rowsCount - 1, 0 To columnsCount - 1)

    For i = 1 To root.ChildNodes.Length - 1 'rowcount已经减过1了
        For j = 0 To columnsCount - 1
           arrContent(i - 1, j) = root.ChildNodes(i).ChildNodes(j).Text
        Next
    Next

    Set doc = Nothing
    
    getContentArray = arrContent
End Function