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