Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBScript function to covert XML file to JSON string

Status
Not open for further replies.

humsha

Programmer
Jun 16, 2016
1
US
Hi All,
I am trying to convert a complex multi element XML file to a JSON string.

Does anyone knows of a vbscript function to convert xml to json. I actually found one function in vbscript that converts XML to JSON, but it works only if the xml has single element. My XML has multi elements and it's not converting to JSON correctly. Even I pass multi elements xml in request it returns only single element from it in JSON.

I'm using UFT tool to perform this task.

Please help. Thanks in advance.

Following are the two functions that I found online - I am not a VBscript expert so I am unable to understand why its not returning multi elements in JSON string. It works perfectly for single elements. Any help or suggestions to fix the code will be highly appreciated.

Function XML2JSON(ByVal xml)

'Create the COM object
Dim doc
Set doc = CreateObject("Msxml2.DOMDocument.3.0")

'Load the XML document and wait until it's ready
doc.async = False
doc.loadXML(xml)

'Get the root element of the document
Dim root
Set root = doc.documentElement

'Start calling the recursive conversion function at the root element
Dim outStr
outStr = XML2JSON_Recurse(root, False)
XML2JSON = outStr

End Function

Function XML2JSON_Recurse(ByVal node, ByVal isAnonymous)

nodeString = ""

'If the node has no children, then it contains the empty string
If Not node.hasChildNodes() Then

'Write a key-value pair unless this node is part of an array, in which case
'just write the empty string
If isAnonymous = False Then
nodeString = """" & node.baseName & """:"""""
Else
nodeString = """"""
End If

'If the node has only one child and no grandchildren, then its child is a leaf
'containing text
ElseIf node.firstChild Is node.lastChild And Not node.firstChild.hasChildNodes() Then

'Write a key-value pair unless this node is part of an array, in which case
'just write the text value
If isAnonymous = False Then
nodeString = """" & node.baseName & """:""" & node.text & """"
Else
nodeString = """" & node.text & """"
End If

Else

Dim isArray
isArray = False

'If this node's name ends in "_list", then it's an array rather than an
'object
If Right(node.baseName, 5) = "_list" Then
isArray = True
End If

'Recurse on each of the node's children, passing them the value of isArray
'as their isAnonymous parameter
For Each child In node.childNodes
nodeString = nodeString & XML2JSON_Recurse(child, isArray) & ","
Next

'Get rid of the final comma from the list of children
nodeString = Left(nodeString, Len(nodeString) - 1)

'Enclose the list in square or curly brackets (depending on isArray)
If isArray = True Then
nodeString = "[" & nodeString & "]"
Else
nodeString = "{" & nodeString & "}"
End If

'If this node is not an item in an array and is not the root node, prepend
'its name to create a key-value pair
If isAnonymous = False Then
If isArray = True Then
nodeString = """" & Left(node.baseName, Len(node.baseName) - 5) & """:" & nodeString
Else
If Not node.baseName = "root" Then
nodeString = """" & node.baseName & """:" & nodeString
End If
End If
End If

End If

XML2JSON_Recurse = nodeString

End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top