使用VBA导入XML到Excel时仅提取SampleBarcode单列数据

问题说明 #

• 原手动操作流程：通过右键菜单选择「导入-XML」导入每日更新的XML文件（单晚最多导入5份），手动操作支持仅选中所需单列目标数据导入
• 已完成的VBA功能：支持指定单元格位置导入、弹窗询问确认是否继续后续导入、流程结束后自动打印
• 当前代码缺陷：调用Workbooks.OpenXML方法导入XML时会强制加载全部26列数据，无法实现单列导入需求
• 调整目标：仅提取XML中<SampleBarcode>节点存储的样本条码值（示例值：2022000009），以单列形式写入指定目标位置

实现逻辑 #

Workbooks.OpenXML方法本身是按照XML全结构映射生成表格，没有导入时筛选列的参数，不需要用这个方法全量加载文件，直接通过XML DOM对象定向读取目标节点值即可，读取效率比全量导入高，也不会产生多余列。

可直接复用的代码 #

Sub 导入XML样本条码()
    Dim xmlDoc As Object
    Dim xmlNodes As Object
    Dim xmlNode As Object
    Dim targetRng As Range
    Dim filePaths As Variant
    Dim i As Long, nextRow As Long
    Dim confirmRes As VbMsgBoxResult
    
    ' 这里替换成你实际要写入的起始目标单元格，比如Sheets("导入表").Range("A2")
    Set targetRng = ThisWorkbook.Sheets("数据导入").Range("A2")
    
    ' 选择要导入的XML文件，最多选5个，匹配日常使用场景
    filePaths = Application.GetOpenFilename("XML文件(*.xml),*.xml", Title:="选择要导入的XML文件", MultiSelect:=True)
    If IsArray(filePaths) = False Then Exit Sub ' 用户点取消则直接退出
    If UBound(filePaths) > 5 Then
        MsgBox "单次最多导入5份XML文件，请重新选择", vbExclamation
        Exit Sub
    End If
    
    ' 沿用原有弹窗确认逻辑
    confirmRes = MsgBox("已选中" & UBound(filePaths) & "份XML文件，是否确认开始导入？", vbYesNo + vbQuestion, "导入确认")
    If confirmRes = vbNo Then Exit Sub
    
    ' 初始化XML解析对象，后期绑定不需要手动添加库引用
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    xmlDoc.Async = False
    xmlDoc.validateOnParse = False
    
    nextRow = 0 ' 记录写入行偏移量
    For i = LBound(filePaths) To UBound(filePaths)
        If xmlDoc.Load(filePaths(i)) Then
            ' 匹配文件内所有SampleBarcode节点
            Set xmlNodes = xmlDoc.SelectNodes("//SampleBarcode")
            For Each xmlNode In xmlNodes
                ' 逐行写入目标列
                targetRng.Offset(nextRow, 0).Value = xmlNode.Text
                nextRow = nextRow + 1
            Next xmlNode
        Else
            MsgBox "文件" & filePaths(i) & "解析失败，请检查文件完整性", vbExclamation
        End If
    Next i
    
    ' 释放对象占用
    Set xmlNodes = Nothing
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
    
    ' 后续直接拼接原有流程、自动打印逻辑即可
    MsgBox "导入完成，共导入" & nextRow & "条样本条码", vbInformation
End Sub

使用说明 #

• 代码里的targetRng参数直接替换成原来指定的导入起始单元格位置即可，之前写好的弹窗确认、自动打印等逻辑可以直接接在代码末尾，不需要改动
• 代码默认支持多文件导入，自动限制单次最多选5个文件，和日常使用场景匹配
• 如果单个XML文件内存在多个<SampleBarcode>节点，会自动按节点顺序逐行写入单列，不会生成多余列
• 不需要额外配置Office引用，直接把原来的Workbooks.OpenXML相关导入代码替换成上述逻辑即可正常运行

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