Sub ImportUCPDealData()

Application.ScreenUpdating = False

Dim LO As ListObject, Counter, LOName As String, Request As MSXML2.XMLHTTP60, Parameters, I As Integer, NMID, FundCodeRandNumber As Integer

FundCodeRandNumber = Application.WorksheetFunction.RandBetween(2, 679)

Parameters = Application.Transpose(shInputJSON.Range("A1").CurrentRegion.Offset(1))

Parameters(23) = "<FNumber>" & Application.WorksheetFunction.RandBetween(1000000000, 9999999999#) & "</FNumber>"
Parameters(24) = "<iKey>" & "00" & Application.WorksheetFunction.RandBetween(1, 9) & "</iKey>"

For Counter = LBound(Parameters) To UBound(Parameters)
Parameters(Counter) = Trim(Parameters(Counter))
Next Counter

Parameters = Join(Parameters)

Set Request = New MSXML2.XMLHTTP60

With Request
.Open "POST", "http://192.168.9.999//Zservice/XServiceREST.svc/ImportData", False
.setRequestHeader "Content-Type", "application/xml; charset=utf-8" ' "application/x-www-form-urlencoded"
.send Parameters
NMID = FetchXMLValue(.responseText, "NMID")
End With

Debug.Print NMID

shInputJSON.Range("D2") = NMID

Application.ScreenUpdating = True

End Sub

Function FetchXMLValue(XML, TagName)

Dim xDoc As MSXML2.DOMDocument60, List As IXMLDOMNodeList, Attr As IXMLDOMAttribute, Node As IXMLDOMNode, ChildNode As IXMLDOMNode

Set xDoc = New MSXML2.DOMDocument60
'xDoc.setProperty "ProhibitDTD", False

If Not xDoc.LoadXML(XML) Then
Err.Raise xDoc.parseError.ErrorCode, , xDoc.parseError.reason
End If

Set List = xDoc.SelectNodes("//ResponseBody/" & TagName)

For Each Node In List

Set Attr = Node.Attributes.getNamedItem(TagName)
If (Not Attr Is Nothing) Then
'Debug.Print Attr.BaseName & " " & Attr.Text
End If

If (Node.HasChildNodes) Then
For Each ChildNode In Node.ChildNodes
'Debug.Print ChildNode.BaseName & " " & ChildNode.Text
FetchXMLValue = ChildNode.Text
Exit For
Next ChildNode
End If

Next Node

End Function