Loop that extracts XML nodes into table under the corresponding headers

Question

I read an XML document to collect user logon times.

<UserName="Jenny" Monday="7:00" Tuesday="7:30" Wednesday="0" Thursday="7:10" Friday="7:25" Saturday="6:00" Sunday="0"/><UserName="Simon" Monday="8:20" Tuesday="7:45" Wednesday="7:45" Thursday="7:10" Friday="7:25" Saturday="7:00" Sunday="0"/><UserName="Jenny" Monday="8:00" Tuesday="8:30" Wednesday="8:00" Thursday="7:10" Friday="7:25" Saturday="0" Sunday="0"/>Chris

I can get and paste info into a table on an Excel spreadsheet one by one.

Dim pTeamTimes As New XMLdoc  
Dim objPlan As IXMLDOMElement
        
'build file path
strTeamXMLPath = "C:\Users\Public\Libraries\Times" & ".xml"
        
'load document
objPlan .LoadDocument strTeamXMLPath , "TeamTimes"
                          
For Each objPlan In pTeamTimes.Root.ChildNodes 
    
    .Cells(intRow, 13) = User
    .Cells(intRow, 14) = objPlan .getAttribute("Monday")
    .Cells(intRow, 15) = objPlan .Attributes.getNamedItem("Tuesday").Text
    .Cells(intRow, 16) = objPlan .Attributes.getNamedItem("Wednesday").Text
    .Cells(intRow, 17) = objPlan .Attributes.getNamedItem("Thursday").Text
    .Cells(intRow, 18) = objPlan .Attributes.getNamedItem("Friday").Text
    .Cells(intRow, 19) = objPlan .Attributes.getNamedItem("Saturday").Text
    .Cells(intRow, 20) = objPlan .Attributes.getNamedItem("Sunday").Text
    intRow = intRow + 1
                              
Next objPlan

This pastes the data into a table with the user name on the left and the times to the right row by row (see below).

User|Monday|Tuesday|Wednesday|Thursday|Friday|Saturday|Sunday

Is there a way to loop through the file and extract the appropriate data for the appropriate header?

I also played with .getAttribute("Monday") and .Attributes.getNamedItem("Tuesday").Text

Is there a major difference in using each of these methods?

T.M. T.M. · Accepted Answer · 2020-11-15T21:13:09

Streamlining display of xml node attributes (array approach)

Your XML file snippet's syntax isn't correct. Each node has to show its node name after the opening bracket <SomeNode ...>, but this nodename cannot be followed immediately by an equals character = indicating always a following attribute assignment.

Therefore I built a wellformed xml structure to be able to illustrate a working MCV Example choosing to ("re")name the individual nodes <User ...> followed by UserName and weekday attributes (Monday="7:00" Tuesday="" ...).

<?xml version="1.0" encoding="UTF-8"?>
<AllUsers>
  <Team>
    <User UserName="Jenny" Monday="7:00" Tuesday="7:30" Wednesday="0" Thursday="7:10" Friday="7:25" Saturday="6:00" Sunday="0"/>
    <User UserName="Simon" Monday="8:20" Tuesday="7:45" Wednesday="7:45" Thursday="7:10" Friday="7:25" Saturday="7:00" Sunday="0"/>
    <User UserName="Jenny2" Monday="8:00" Tuesday="8:30" Wednesday="8:00" Thursday="7:10" Friday="7:25" Saturday="0" Sunday="0"/>
  </Team>
</AllUsers>

Example code

Based on this assumed example structure (loaded here via .LoadXML), I demonstrate how to streamline code getting attributes via a NodeList loop based on the following xml content.

In order to allow a quickly reproducible example, I didn't refer to an external file via .Load, but to a pure string content (received by help function getContent()) loaded via .LoadXML. Of course loading an external file needs the following syntax: xDoc.Load strTeamXMLPath. - Btw several parts of the original code aren't clear, e.g. I don't know what's behind .LoadDocument

Sub GetAttributes()
    Dim xdoc  As MSXML2.DOMDocument60       ' early binding needs reference to Microsoft 'XML, v6.0'
    Set xdoc = New MSXML2.DOMDocument60
    
    If xdoc.LoadXML(getContent()) Then
        Dim users As MSXML2.IXMLDOMNodeList
        Set users = xdoc.SelectNodes("//Team/User")     ' nodelist is zero-based
        ReDim tmp(1 To users.Length, 1 To 8)
        
        Dim i As Long
        For i = 1 To users.Length
            Dim j As Long
            For j = 1 To users(i - 1).Attributes.Length
                'assign to 1-based 2-dim tmp array
                '(whereas users nodelist incl. node attributes list are zero-based!)
                tmp(i, j) = users(i - 1).Attributes(j - 1).Text
                'Debug.Print i & "." & j, tmp(i, j)      ' optional display in VB Editor's immediate window
            Next
            Debug.Print i, Join(Application.Index(tmp, i, 0), "|")
        Next i
    Else    ' XML Parse Error
        Debug.Print getParseError(xdoc)
    End If
    ' write tmp to any target
    With Sheet1                               ' << change to your project's sheet Code(Name)
'        'a) write captions starting from cell M1 (optional)
'        For i = 1 To UBound(tmp, 2)
'            .Range("M1").Offset(0, i - 1) = users(0).Attributes(i - 1).BaseName
'        Next i
        'write tmp results
        .Range("M2").Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp
    End With
    End Sub

Additionaly you could test other syntax, e.g. for the 1st user (Jenny) to get the Monday attribute:

    Debug.Print users(0).Attributes.getNamedItem("Monday").BaseName                ' "Monday"
    Debug.Print users(0).Attributes.getNamedItem("Monday").Text                    ' 7:00
    Debug.Print xdoc.DocumentElement.SelectSingleNode("Team/User[1]/@Monday").Text ' 7:00

Help functions

Function getContent() gets an assumed minimal, but wellformed xml string content as described above replacing the unknown structure of OP's external file content.

Function getContent() As String
Dim tmp As String
tmp = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbNewLine
tmp = tmp & "<AllUsers>" & vbNewLine & "  <Team>" & vbNewLine & _
vbTab & "<User UserName=""Jenny"" Monday=""7:00"" Tuesday=""7:30"" Wednesday=""0"" Thursday=""7:10"" Friday=""7:25"" Saturday=""6:00"" Sunday=""0""/>" & vbNewLine & _
vbTab & "<User UserName=""Simon"" Monday=""8:20"" Tuesday=""7:45"" Wednesday=""7:45"" Thursday=""7:10"" Friday=""7:25"" Saturday=""7:00"" Sunday=""0""/>" & vbNewLine & _
vbTab & "<User UserName=""Jenny2"" Monday=""8:00"" Tuesday=""8:30"" Wednesday=""8:00"" Thursday=""7:10"" Friday=""7:25"" Saturday=""0"" Sunday=""0""/>" & vbNewLine & _
"  </Team>" & vbNewLine & "</AllUsers>"
getContent = tmp
Debug.Print getContent
End Function

Function getParseError(xdoc As MSXML2.DOMDocument60) As String
        Dim xPE As MSXML2.IXMLDOMParseError
        Set xPE = xdoc.parseError
        With xPE
            getParseError = "Load Error " & .ErrorCode & " XML File " & vbCrLf & _
                  Replace(.Url, "file:///", "") & vbCrLf & vbCrLf & _
                  xPE.reason & _
                  "Source Text: " & .srcText & vbCrLf & vbCrLf & _
                  "Line No:    " & .Line & vbCrLf & _
                  "Line Pos:  " & .linepos & vbCrLf & _
                  "File Pos:  " & .filepos & vbCrLf & vbCrLf
        End With
End Function

Loop that extracts XML nodes into table under the corresponding headers

1 Answers