如何在Excel中通过VBA宏实现按钮点击批量导入多个XML文件

功能适配 #

• 支持同时选择多个XML文件批量导入
• 自动拆分测量记录、告警记录两类数据分别存储
• 自动添加表头、转换时间格式，适配你提供的XML结构

完整可运行代码 #

Option Explicit
Sub CommandButton_Click()
    Dim fd As Office.FileDialog
    Dim xdoc As Object
    Dim xmlFileName As String
    Dim measNodes As Object, alertNodes As Object
    Dim node As Object
    Dim measRow As Long, alertRow As Long
    Dim wsMeas As Worksheet, wsAlert As Worksheet
    
    ' 初始化存储数据表
    On Error Resume Next
    Set wsMeas = ThisWorkbook.Sheets("测量记录")
    Set wsAlert = ThisWorkbook.Sheets("告警记录")
    On Error GoTo 0
    
    If wsMeas Is Nothing Then
        Set wsMeas = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsMeas.Name = "测量记录"
    End If
    If wsAlert Is Nothing Then
        Set wsAlert = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsAlert.Name = "告警记录"
    End If
    
    ' 写入表头并初始化行号
    wsMeas.Cells.Clear
    wsMeas.Range("A1:C1") = Array("测量ID", "设备序列号", "测量时间")
    measRow = 2
    
    wsAlert.Cells.Clear
    wsAlert.Range("A1:C1") = Array("告警ID", "设备序列号", "告警编码")
    alertRow = 2
    
    ' 选择XML文件
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Title = "选择多个XML文件"
        .Filters.Add "XML文件", "*.xml", 1
        .AllowMultiSelect = True
        
        If .Show <> True Then Exit Sub
        
        Set xdoc = CreateObject("MSXML2.DOMDocument.6.0")
        xdoc.async = False
        xdoc.validateOnParse = False
        xdoc.SetProperty "SelectionNamespaces", "xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xsd='http://www.w3.org/2001/XMLSchema'"
        
        Dim i As Long
        For i = 1 To .SelectedItems.Count
            xmlFileName = .SelectedItems(i)
            If Not xdoc.Load(xmlFileName) Then
                MsgBox "文件加载失败：" & xmlFileName, vbExclamation
                GoTo nextFile
            End If
            
            ' 解析测量记录节点
            Set measNodes = xdoc.SelectNodes("//MeasurementServiceLog")
            For Each node In measNodes
                wsMeas.Cells(measRow, 1) = node.SelectSingleNode("MeasurementId").Text
                wsMeas.Cells(measRow, 2) = node.SelectSingleNode("SerialNumber").Text
                wsMeas.Cells(measRow, 3) = CDate(Replace(node.SelectSingleNode("Time").Text, "T", " "))
                measRow = measRow + 1
            Next node
            
            ' 解析告警记录节点
            Set alertNodes = xdoc.SelectNodes("//Alert")
            For Each node In alertNodes
                wsAlert.Cells(alertRow, 1) = node.SelectSingleNode("AlertGuid").Text
                wsAlert.Cells(alertRow, 2) = node.SelectSingleNode("SerialNumber").Text
                wsAlert.Cells(alertRow, 3) = node.SelectSingleNode("alertCode").Text
                alertRow = alertRow + 1
            Next node
            
nextFile:
        Next i
    End With
    
    ' 自动调整列宽优化显示
    wsMeas.Columns("A:C").AutoFit
    wsAlert.Columns("A:C").AutoFit
    
    Set xdoc = Nothing
    Set fd = Nothing
    MsgBox "导入完成，共导入" & measRow - 2 & "条测量记录，" & alertRow - 2 & "条告警记录", vbInformation
End Sub

使用说明 #

• 按Alt+F11打开VBA编辑器，将代码粘贴到按钮的点击事件模块中
• 将Excel文件保存为.xlsm格式，开启宏权限后运行即可
• 重复运行会清空两个存储表的历史数据重新导入，如需追加数据可自行修改表头判断逻辑

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