Public Function SearchForNodes(ByVal strXML As String, ByVal strTag As String, ByVal strSearchText As String) As DOMDocument
'Will Search an XML String for a Tag-value pair and return
'the entire node containing that pair in the form
'of a DOM Document: 'REQUIRES REFERENCE TO MSXML
'EXAMPLE: 'Dim objXMLDoc As New DOMDocument
'Dim objXMLFound As DOMDocument 'Dim strXML As String
'Load XML from file 'If objXMLDoc.Load("C:\My Documents\MyXMLFile.xml") Then
'strXML = objXMLDoc.xml 'Search for a tag that looks like this in the xml:
'583 'Set objXMLFound = SearchForNodes(strXML, "User_ID", "583")
'Display the Node that was found 'Debug.Print objXMLFound.xml
'End If
Dim lngIterator As Long
Dim strResults As String
Dim objXMLSearchDocument As DOMDocument
Dim objXMLSearchElements As IXMLDOMSelection
Dim objXMLSearchElement As IXMLDOMElement
Dim strXPath As String
strResults = ""
Set objXMLSearchDocument = New DOMDocument
objXMLSearchDocument.async = False
objXMLSearchDocument.setProperty "SelectionLanguage", "XPath"
Call objXMLSearchDocument.loadXML(strXML)
Set objXMLSearchElements = objXMLSearchDocument.getElementsByTagName(strTag)
If objXMLSearchElements.length > 0 Then
Set objXMLSearchElement = objXMLSearchElements.Item(0)
Do Until Len(objXMLSearchElement.parentNode.baseName) = 0
strXPath = "/" + objXMLSearchElement.parentNode.baseName + strXPath
Set objXMLSearchElement = objXMLSearchElement.parentNode
Loop
Set objXMLSearchElement = Nothing
strXPath = strXPath + "[" + strTag + " = '" + strSearchText + "']"
End If
Set objXMLSearchElements = Nothing
If Len(strXPath) > 0 Then
Set objXMLSearchElements = objXMLSearchDocument.selectNodes(strXPath)
If objXMLSearchElements.length > 0 Then
For lngIterator = 0 To (objXMLSearchElements.length - 1)
strResults = strResults + objXMLSearchElements.Item(lngIterator).xml
Next lngIterator
End If
Set objXMLSearchElements = Nothing
End If
Set objXMLSearchDocument = Nothing
strResults = strResults + ""
Set objXMLSearchDocument = New DOMDocument
objXMLSearchDocument.async = False
Call objXMLSearchDocument.loadXML(strResults)
Set SearchForNodes = objXMLSearchDocument
Set objXMLSearchDocument = Nothing
End Function
