Extracting Certain Fields from XML File to Excel - PLEASE HELP!!!

[pritchardev]

Hello all,

I’ve got a folder on my desktop where I automatically download and save a number of XML files. In each of these XML files are 3 fields that I am trying to extract neatly onto 3 separate columns on an excel file for reporting purposes – The LPN #, the Container # and the PO #. So far, I’ve got the code below (I did not write it – unfortunately, I’m a novice so all credit goes to user Maudibe). My issue is that this code only seems to extract the first LPN # from each file as opposed to all LPN’s.

For instance, in one of my files, I may have 250 LPN #’s. What I’m trying to do is extract all 250 LPN’s in the file along with the corresponding Container #’s and PO #’s before moving onto the next file in the folder and repeating the process. Does anyone know how I can easily fix this? Any help is much appreciated!


Public row As Long
Sub ListFiles()
'LISTFILES AND LISTMYFILES MODIFIED FROM
'http://excelexperts.com/VBA-Tips-List-Files-In-A-Folder
'CODE TO EXTRACT AND MAP DATA BY MAUDIBE
'--------------------------------------------------------------------
'DECLARE AND SET VARIABLES
Dim ShellApplication As Object
Application.ScreenUpdating = False
'--------------------------------------------------------------------
'GET SOURCE FOLDER
Set ShellApplication = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
If ShellApplication Is Nothing Then
Exit Sub
Else: Path = ShellApplication.self.Path
End If
Set ShellApplication = Nothing
'--------------------------------------------------------------------
'ADD HEADER
[a3] = "ContainerNumber"
[b3] = "PONumber"
[c3] = "LPN"
row = 4
'--------------------------------------------------------------------
'CALL ROUTINE TO CYCLE THROUGH FOLDER
Call ListMyFiles(Path, True)
End Sub


Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Application.ScreenUpdating = False
'--------------------------------------------------------------------
'DECLARE AND SET VARIABLES
Dim BookTypeArray() As String
Set MyObject = New Scripting.FileSystemObject
Set MySource = MyObject.GetFolder(mySourcePath)
'--------------------------------------------------------------------
'FIND XML FILES ONLY IN SCOURCE FOLDER
For Each myfile In MySource.Files
If Right(myfile.Name, 3) = "XML" Or Right(myfile.Name, 3) = "xml" Then
'-------------------------------------------------------------
'IMPORT XML NODES
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.SetProperty "SelectionLanguage", "XPath"
xmlDoc.Async = False
xmlDoc.Load (mySourcePath & "\" & myfile.Name)
Set nodeXML1 = xmlDoc.getElementsByTagName("ContainerNumber")
Set nodeXML2 = xmlDoc.getElementsByTagName("PONumber")
Set nodeXML3 = xmlDoc.getElementsByTagName("LPN")
Cells(row, 1) = nodeXML1(0).Text
Cells(row, 2) = nodeXML2(0).Text
Cells(row, 3) = nodeXML3(0).Text
row = row + 1
End If
Next
'-------------------------------------------------------------
'FIND XML FILES ONLY IN SOURCE SUBFOLDERS
If IncludeSubfolders Then
For Each MySubFolder In MySource.SubFolders
Call ListMyFiles(MySubFolder.Path, True)
Next
End If
'-------------------------------------------------------------
'CLEANUP
Set MyObject = Nothing
Set MySource = Nothing
Set xmlDoc = Nothing
Set nodeXML1 = Nothing
Set nodeXML2 = Nothing
Set nodeXML3 = Nothing
Application.ScreenUpdating = True
End Sub


Thank you!

Evan

 

[pritchardev]

Apologies all, code in a more readable format below!

Public row As LongSub ListFiles()
'LISTFILES AND LISTMYFILES MODIFIED FROM
'http://excelexperts.com/VBA-Tips-List-Files-In-A-Folder
'CODE TO EXTRACT AND MAP DATA BY MAUDIBE
'--------------------------------------------------------------------
'DECLARE AND SET VARIABLES
    Dim ShellApplication As Object
    Application.ScreenUpdating = False
'--------------------------------------------------------------------
'GET SOURCE FOLDER
    Set ShellApplication = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    If ShellApplication Is Nothing Then
        Exit Sub
    Else: Path = ShellApplication.self.Path
    End If
    Set ShellApplication = Nothing
'--------------------------------------------------------------------
'ADD HEADER
    [a3] = "ContainerNumber"
    [b3] = "PONumber"
    [c3] = "LPN"
    row = 4
'--------------------------------------------------------------------
'CALL ROUTINE TO CYCLE THROUGH FOLDER
    Call ListMyFiles(Path, True)
End Sub




Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Application.ScreenUpdating = False
'--------------------------------------------------------------------
'DECLARE AND SET VARIABLES
    Dim BookTypeArray() As String
    Set MyObject = New Scripting.FileSystemObject
    Set MySource = MyObject.GetFolder(mySourcePath)
'--------------------------------------------------------------------
'FIND XML FILES ONLY IN SCOURCE FOLDER
    For Each myfile In MySource.Files
        If Right(myfile.Name, 3) = "XML" Or Right(myfile.Name, 3) = "xml" Then
'-------------------------------------------------------------
'IMPORT XML NODES
           Set xmlDoc = CreateObject("Microsoft.XMLDOM")
           xmlDoc.SetProperty "SelectionLanguage", "XPath"
           xmlDoc.Async = False
           xmlDoc.Load (mySourcePath & "\" & myfile.Name)
           Set nodeXML1 = xmlDoc.getElementsByTagName("ContainerNumber")
           Set nodeXML2 = xmlDoc.getElementsByTagName("PONumber")
           Set nodeXML3 = xmlDoc.getElementsByTagName("LPN")
           Cells(row, 1) = nodeXML1(0).Text
           Cells(row, 2) = nodeXML2(0).Text
           Cells(row, 3) = nodeXML3(0).Text
           row = row + 1
       End If
    Next
'-------------------------------------------------------------
'FIND XML FILES ONLY IN SOURCE SUBFOLDERS
    If IncludeSubfolders Then
       For Each MySubFolder In MySource.SubFolders
          Call ListMyFiles(MySubFolder.Path, True)
       Next
    End If
'-------------------------------------------------------------
'CLEANUP
    Set MyObject = Nothing
    Set MySource = Nothing
    Set xmlDoc = Nothing
    Set nodeXML1 = Nothing
    Set nodeXML2 = Nothing
    Set nodeXML3 = Nothing
Application.ScreenUpdating = True
End Sub

 

[anvg]

Hi
Without analysis of xml-file structure it is difficult to give a answer. Commonly it is to use xmlDol.SelectNodes("//NodeName") for getting all nodes with equal in the document.
Regards,