如何使用 Excel 表中的 VBA 宏在按钮单击事件上导入多个 XML 文件？

Question

我是 VBA 的新手。 我正在尝试使用 VBA 宏从 Excel 文件中加载多个 XML 文件。 我可以通过 excel 一次一个文件的内置功能轻松完成。 但要求是通过使用 VBA 的按钮单击事件来完成 select 多个 XML 文件。

我已经为 select 文件编写了部分 VBA 代码，但我不知道如何格式化 t，如下例所示

来源 XML 文件 1：

<?xml version="1.0" encoding="utf-8"?>
<XMLList xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
  <measList>
        <MeasurementServiceLog>
          <MeasurementId>10001</MeasurementId>  
          <SerialNumber>12345678</SerialNumber> 
          <Time>2019-02-14T10:24:31</Time> 
        </MeasurementServiceLog>
        <MeasurementServiceLog>
        <MeasurementId>10002</MeasurementId>  
          <SerialNumber>12345678</SerialNumber> 
          <Time>2019-03-11T10:24:31</Time> 
        </MeasurementServiceLog>   
  </measList>  
  <alertList>
    <Alert>
      <AlertGuid>101</AlertGuid>  
      <SerialNumber>12345678</SerialNumber> 
      <alertCode>28</alertCode> 
    </Alert> 
     <Alert>
      <AlertGuid>102</AlertGuid>  
      <SerialNumber>12345678</SerialNumber> 
      <alertCode>23</alertCode> 
    </Alert>     
  </alertList>  
</XMLList>

源 xml 文件 2：

 <?xml version="1.0" encoding="utf-8"?>
    <XMLList xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
      <measList>
            <MeasurementServiceLog>
              <MeasurementId>20001</MeasurementId>  
              <SerialNumber>22334455</SerialNumber> 
              <Time>2020-02-14T10:24:31</Time> 
            </MeasurementServiceLog>
            <MeasurementServiceLog>
            <MeasurementId>20002</MeasurementId>  
              <SerialNumber>22334455</SerialNumber> 
              <Time>2020-03-11T10:24:31</Time> 
            </MeasurementServiceLog>   
      </measList>  
      <alertList>
        <Alert>
          <AlertGuid>301</AlertGuid>  
          <SerialNumber>22334455</SerialNumber> 
          <alertCode>65</alertCode> 
        </Alert> 
         <Alert>
          <AlertGuid>302</AlertGuid>  
          <SerialNumber>22334455</SerialNumber> 
          <alertCode>54</alertCode> 
        </Alert>     
      </alertList>  
    </XMLList>

预期 Output：

或者

VBA 源码：

Sub CommandButton_Click()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Filters.Clear
    .Title = "Select the Multiple XML file"
    .Filters.Add "XML File", "*.xml", 1
    .AllowMultiSelect = True
    
    If .Show = True Then
    Dim xdoc As Object
    Set xdoc = CreateObject("MSXML2.DOMDocument")
    xdoc.async = False: xdoc.validateOnParse = False
    row_number = 1
    For i = 1 To .SelectedItems.Count
    xmlFileName = fd.SelectedItems(i)
    xdoc.Load (xmlFileName)
   Set Products = xdoc.DocumentElement
            For Each Product In Products.ChildNodes
        '  Application.Range("measList").Cells(row_number, 0).Value = Product.ChildNodes(0).Text
           
          For Each prt In Product.ChildNodes
            Application.Range("MeasurementServiceLog").Cells(row_number, 1).Value = prt.ChildNodes(0).Text
  
            
           Next prt
           
          Debug.Print "PatientGuid" & Product.ChildNodes(1).Text
       '    Debug.Print "[" & Product.ChildNodes(0).Text & "] = [" & Product.ChildNodes(0).Text & "]"
        row_number = row_number + 1
    Next Product
    Next i
    End If
End With
End Sub
 

Answer 1

使用每个节点的值构建一个二维数组（2,6）。 使用SelectSingleNode("NodeName")填充正确的列。

Option Explicit

Sub CommandButton_Click()
  
    Dim fd As Office.FileDialog, xmlfile As Collection, i As Long
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Set xmlfile = New Collection
        
    ' build collection of files
    With fd
        .Filters.Clear
        .Title = "Select the Multiple XML file"
        .Filters.Add "XML File", "*.xml", 1
        .AllowMultiSelect = True
        If .Show = True Then
             For i = 1 To .SelectedItems.Count
                 xmlfile.Add .SelectedItems(i)
             Next
        Else
            Exit Sub
        End If
    End With
    
    ' process files
    Dim xdoc As Object, node As Object
    Dim arOut, r As Long, c As Long, n As Long
    Dim rngOut As Range
    
    Set xdoc = CreateObject("MSXML2.DOMDocument")
    xdoc.async = False:
    xdoc.validateOnParse = False

    Set rngOut = Sheet1.Range("A2") ' or Range("MeasurementServiceLog").Cells(1,1)
    
    For i = 1 To xmlfile.Count
        ReDim arOut(1 To 2, 1 To 6)
        xdoc.Load xmlfile(i)
        
        'meas
        r = 0
        For Each node In xdoc.SelectNodes("//measList/MeasurementServiceLog")
            r = r + 1
            arOut(r, 1) = node.SelectSingleNode("MeasurementId").Text
            arOut(r, 2) = node.SelectSingleNode("SerialNumber").Text
            arOut(r, 3) = node.SelectSingleNode("Time").Text
        Next
        
        'alert
        r = 0
        For Each node In xdoc.SelectNodes("//alertList/Alert")
            r = r + 1
            arOut(r, 4) = node.SelectSingleNode("AlertGuid").Text
            arOut(r, 5) = node.SelectSingleNode("SerialNumber").Text
            arOut(r, 6) = node.SelectSingleNode("alertCode").Text
        Next

        rngOut.Resize(2, 6) = arOut
        'rngOut.Offset(, 7) = xmlfile(i) ' for debugging
        Set rngOut = rngOut.Offset(3)
              
    Next
    MsgBox xmlfile.Count & " files imported", vbInformation
    
End Sub

Answer 2

选项显式

子命令按钮_MultiFileSelectClick()

Dim Alert_OutSheet As Worksheet

Dim fd As Office.FileDialog, xmlfile As Collection, i As Long
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set xmlfile = New Collection
Sheets.Add.Name = "MultiAlert"
Set Alert_OutSheet = ThisWorkbook.Sheets("MultiAlert")
    
' build collection of files
With fd
    .Filters.Clear
    .Title = "Select the Multiple XML file"
    .Filters.Add "XML File", "*.xml", 1
    .AllowMultiSelect = True
    If .Show = True Then
         For i = 1 To .SelectedItems.Count
             xmlfile.Add .SelectedItems(i)
         Next
    Else
        Exit Sub
    End If
End With

' process files
Dim xdoc As Object, node As Object
Dim arOut, r As Long, c As Long, n As Long
Dim rngOut As Range

Set xdoc = CreateObject("MSXML2.DOMDocument")
xdoc.async = False:
xdoc.validateOnParse = False

Set rngOut = Alert_OutSheet.Range("A2") ' or Range("MeasurementServiceLog").Cells(1,1)

For i = 1 To xmlfile.Count
    ReDim arOut(1 To 2, 1 To 6)
    xdoc.Load xmlfile(i)
    
    'meas
    r = 0
    For Each node In xdoc.SelectNodes("//measList/MeasurementServiceLog")
        r = r + 1
        arOut(r, 1) = node.SelectSingleNode("MeasurementId").Text
        arOut(r, 2) = node.SelectSingleNode("SerialNumber").Text
        arOut(r, 3) = node.SelectSingleNode("Time").Text
    Next
    
    'alert
    r = 0
    For Each node In xdoc.SelectNodes("//alertList/Alert")
        r = r + 1
        arOut(r, 4) = node.SelectSingleNode("AlertGuid").Text
        arOut(r, 5) = node.SelectSingleNode("SerialNumber").Text
        arOut(r, 6) = node.SelectSingleNode("alertCode").Text
    Next

    rngOut.Resize(2, 6) = arOut
    'rngOut.Offset(, 7) = xmlfile(i) ' for debugging
    Set rngOut = rngOut.Offset(3)
          
Next
MsgBox xmlfile.Count & " files imported", vbInformation

结束子