Parent page: Service Functions – MSXMLDOM (QTP, TestComplete, VBScript)

Description

Create XML DOM object by loading source XML from string. If the string is empty or source XML is invalid returns Nothing.

Implementation

Public Function CreateXMLDOMFromString(ByVal sXMLSource)
 Dim boolRC, intRC
 Dim objXMLDoc, objXMLRoot
 If Trim(sXMLSource) = "" Then
 Set CreateXMLDOMFromString = Nothing
 Exit Function
 End If
 Set objXMLDoc = CreateObject("Microsoft.XMLDOM")
 objXMLDoc.async = False
 On Error Resume Next
 objXMLDoc.loadXML(sXMLSource)
 intRC = Err.Number
 On Error GoTo 0
 If boolRC Then
 Set objXMLDoc = Nothing
 Set CreateXMLDOMFromString = Nothing
 Exit Function
 End If 
 Set objXMLRoot = objXMLDoc.documentElement
 boolRC = isNull(objXMLRoot) or (objXMLRoot is Nothing) 
 If boolRC Then
 Set objXMLDoc = Nothing
 Set CreateXMLDOMFromString = Nothing
 Exit Function
 End If 
 Set CreateXMLDOMFromString = objXMLDoc
End Function

Test Code

 Set objXMLDoc = CreateXMLDOMFromString("")
 If Not (objXMLDoc is Nothing) Then
 Log.Error "CreateXMLDOMFromString failed"
 End If
 sText = "<root>text<root>"
 Set objXMLDoc = CreateXMLDOMFromString(sText)
 If Not (objXMLDoc is Nothing) Then
 Log.Error "CreateXMLDOMFromString failed"
 End If
 sText = "<root>text</root>"
 Set objXMLDoc = CreateXMLDOMFromString(sText)
 If objXMLDoc is Nothing Then
 Log.Error "CreateXMLDOMFromString failed"
 End If
 sText = "<root>text <case>test case</case></root>"
 Set objXMLDoc = CreateXMLDOMFromString(sText)
 If objXMLDoc is Nothing Then
 Log.Error "CreateXMLDOMFromString failed"
 End If
 Set objXMLNode = ChildElementByName(objXMLDoc.DocumentElement, "case") 
 If objXMLNode is Nothing Then
 Log.Error "CreateXMLDOMFromString failed"
 End If
 If objXMLNode.BaseName <> "case" Then
 Log.Error "CreateXMLDOMFromString failed"
 End If
 If objXMLNode.Text <> "test case" Then
 Log.Error "CreateXMLDOMFromString failed"
 End If