How to import Multiple XML file on button click event using VBA Macro in Excel sheet?-CodePudding

I am new in VBA. I am trying to load the multiple XML file on button click event from Excel file by using VBA macro. I can easily do by excel inbuilt functionality for one file at a time. But the requirement is do by button click event using VBA for select multiple XML file.

I have written the partial VBA code for select the files but I don't know to format t as below example

Source XML file 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>

Source xml file 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>

Expected Output :

VBA Source code :

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

CodePudding user response：

Build a 2D array(2,6) with the values from each node. Use SelectSingleNode("NodeName") to fill the correct column.

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

CodePudding user response：

Option Explicit

Sub CommandButton_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

End Sub