基于VBA开发Excel函数批量解析BI系统XML文件的问题

核心逻辑说明 #

针对你提出的/entries/entry~type格式路径，先将其拆分为父节点路径（/entries/entry）和目标子节点名（type），然后遍历所有匹配的父节点，逐个提取对应子节点的文本值，最终返回合并结果或数组。

示例XML结构 #

<root>
  <entries>
    <entry>
      <type>销售数据</type>
      <amount>1000</amount>
    </entry>
    <entry>
      <type>采购数据</type>
      <amount>800</amount>
    </entry>
  </entries>
</root>

getEachVALUE函数实现代码 #

Function getEachVALUE(xmlPath As String, xpathPattern As String, Optional delimiter As String = ", ") As String
    Dim xmlDoc As Object
    Dim parentNodes As Object
    Dim parentNode As Object
    Dim targetNode As Object
    Dim resultArr() As String
    Dim arrIndex As Integer
    Dim splitParts As Variant
    
    ' 初始化XML解析对象
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    xmlDoc.async = False
    xmlDoc.Load xmlPath
    
    ' 校验并拆分路径格式
    splitParts = Split(xpathPattern, "~")
    If UBound(splitParts) <> 1 Then
        getEachVALUE = "路径格式错误：需使用如/entries/entry~type的格式"
        Exit Function
    End If
    
    ' 获取所有匹配的父节点集合
    Set parentNodes = xmlDoc.SelectNodes(splitParts(0))
    If parentNodes.Length = 0 Then
        getEachVALUE = "未找到匹配的父节点"
        Exit Function
    End If
    
    ' 遍历父节点提取目标值
    ReDim resultArr(0 To parentNodes.Length - 1)
    arrIndex = 0
    For Each parentNode In parentNodes
        Set targetNode = parentNode.SelectSingleNode(splitParts(1))
        resultArr(arrIndex) = IIf(Not targetNode Is Nothing, targetNode.Text, "无值")
        arrIndex = arrIndex + 1
    Next parentNode
    
    ' 返回合并后的字符串（可修改为返回数组支持批量填充）
    getEachVALUE = Join(resultArr, delimiter)
End Function

调用与整合示例 #

1. Excel单元格直接调用 #

在单元格中输入公式：

=getEachVALUE("C:\BI_Data\report_001.xml", "/entries/entry~type", "; ")

返回结果：销售数据; 采购数据

2. 整合到makeMAGIC批量处理 #

将getEachVALUE嵌入现有批量处理流程，实现多文件批量提取：

Sub makeMAGIC()
    Dim fileDialog As Object
    Dim selectedFiles As Variant
    Dim i As Integer
    Dim xmlFilePath As String
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Sheets("批量结果")
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    With fileDialog
        .AllowMultiSelect = True
        .Filters.Add "XML文件", "*.xml"
        If .Show = -1 Then
            selectedFiles = .SelectedItems
            ' 写入表头
            ws.Range("A1:C1") = Array("文件路径", "类型", "金额")
            ' 遍历选中的XML文件
            For i = LBound(selectedFiles) To UBound(selectedFiles)
                xmlFilePath = selectedFiles(i)
                ws.Cells(i + 2, 1).Value = xmlFilePath
                ws.Cells(i + 2, 2).Value = getEachVALUE(xmlFilePath, "/entries/entry~type")
                ws.Cells(i + 2, 3).Value = getEachVALUE(xmlFilePath, "/entries/entry~amount")
            Next i
        End If
    End With
End Sub

内容的提问来源于stack exchange，提问作者gokedeh874