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