Simply the XML

[Flustor]

Just thought I'd drop a thread in, I've written a little ditty that searchs for specific tags within XML and returns a UDT with the details of that tag. (It uses the MSXML.DLL).

Don't know if you'll find it useful but here it is anyhoo:

Option Explicit
'*Super Lucy Code* :-D
Dim XMLDoc                  As MSXML2.DOMDocument
Type XMLPath
    Name            As String
    Properties()    As String
End Type
Type XMLData
    Data            As String
    Properties()    As String
    Path()          As XMLPath
End Type
 
Sub Main()
'This sub demos how to use the other procedures...
Dim myXMLData()   As XMLData
ReDim myXMLData(0)
If GetDataFromXMLDoc("C:\custexp_day.xml", "SYSTEM", myXMLData) = True Then
 
End If
 
End Sub
 
Function GetDataFromXMLDoc(ByVal sFileName As String, ByVal sSearchString As String, ByRef DataFromXML() As XMLData) As Boolean
Set XMLDoc = New DOMDocument
XMLDoc.async = False
XMLDoc.Load sFileName
If XMLDoc.parseError.errorCode = 0 And XMLDoc.readyState = 4 Then
    'Ready
    Call TraverseXML(sSearchString, XMLDoc, DataFromXML, "", "")
End If
End Function
Sub TraverseXML(ByVal sSearchString As String, ByVal XMLDoc As IXMLDOMNode, ByRef DataFromXML() As XMLData, _
                ByVal sPath As String, ByVal sPathProperties As String)
Dim iStep               As Integer
Dim bytStepProperties   As Byte
Dim bytPath             As Byte
Dim bytCountDepthInTree As Byte
Dim bytPathStep         As Byte
Dim varTreeSplit        As Variant
Dim varTreePropSplit    As Variant
 
sPath = sPath & "\" & XMLDoc.baseName
 
sPathProperties = sPathProperties & "¬"
If XMLDoc.baseName <> "" Then
    For bytPathStep = 1 To XMLDoc.Attributes.length
        sPathProperties = sPathProperties & "~" & XMLDoc.Attributes.Item(bytPathStep - 1).baseName & "=" & XMLDoc.Attributes.Item(bytPathStep - 1).nodeValue
    Next bytPathStep
End If
For iStep = 1 To XMLDoc.childNodes.length
    
    
    If XMLDoc.childNodes.Item(iStep - 1).nodeName = sSearchString Then
        ReDim Preserve DataFromXML(UBound(DataFromXML) + 1)
        
        'Read data
        DataFromXML(UBound(DataFromXML)).Data = XMLDoc.childNodes.Item(iStep - 1).nodeTypedValue
        
        'Read properties
        ReDim DataFromXML(UBound(DataFromXML)).Properties(XMLDoc.childNodes.Item(iStep - 1).Attributes.length)
        For bytStepProperties = 1 To XMLDoc.childNodes.Item(iStep - 1).Attributes.length
            DataFromXML(UBound(DataFromXML)).Properties(bytStepProperties) = XMLDoc.childNodes.Item(iStep - 1).Attributes.Item(bytStepProperties - 1).baseName
            DataFromXML(UBound(DataFromXML)).Properties(bytStepProperties) = DataFromXML(UBound(DataFromXML)).Properties(bytStepProperties) & "~" & _
                XMLDoc.childNodes.Item(iStep - 1).Attributes.Item(bytStepProperties - 1).nodeTypedValue
        Next bytStepProperties
            
        'Read Path
        varTreeSplit = Split(sPath, "\", , vbTextCompare)
        bytCountDepthInTree = UBound(varTreeSplit) - 1
 
        ReDim DataFromXML(UBound(DataFromXML)).Path(bytCountDepthInTree)
 
        For bytStepProperties = 1 To bytCountDepthInTree
            DataFromXML(UBound(DataFromXML)).Path(bytStepProperties).Name = varTreeSplit(bytStepProperties + 1)
 
        Next bytStepProperties
        
        'Read path properties into path
        varTreeSplit = Split(sPathProperties, "¬", , vbTextCompare)
        
        'Loop through paths
        For bytStepProperties = 1 To bytCountDepthInTree
            If InStr(1, varTreeSplit(bytStepProperties + 1), "~") > 0 Then
                varTreePropSplit = Split(varTreeSplit(bytStepProperties + 1), "~", , vbTextCompare)
                ReDim DataFromXML(UBound(DataFromXML)).Path(bytStepProperties).Properties(UBound(varTreePropSplit))
            
                'Loop through path properties
                For bytPathStep = 1 To UBound(varTreePropSplit)
                    
                    DataFromXML(UBound(DataFromXML)).Path(bytStepProperties).Properties(bytPathStep) = varTreePropSplit(bytPathStep)
        
                Next bytPathStep
            Else
                ReDim DataFromXML(UBound(DataFromXML)).Path(bytStepProperties).Properties(0)
            End If
        
        Next bytStepProperties
    
    Else
        Call TraverseXML(sSearchString, XMLDoc.childNodes.Item(iStep - 1), DataFromXML, sPath, sPathProperties)
    End If
Next iStep
End Sub