戴尔服务标签请求使用VBA

我正试图让VBA与戴尔SOAP接口一起工作。 我想我已经有99%左右的方式了,因为请求已经成功地将我请求的数据返回给单元格A5。

我不能获得SystemModel节点值。

Private Sub CommandButton1_Click() 'Set and instantiate our working objects Dim sURL As String Dim sEnv As String Set xmlhtp = CreateObject("MSXML2.XMLHTTP") Dim xmldoc As New MSXML2.DOMDocument60 sURL = "http://xserv.dell.com/services/assetservice.asmx?WSD" ' we create our SOAP envelope for submission to the Web Service sEnv = "<?xml version=""1.0"" encoding=""utf-8""?>" sEnv = sEnv & " <soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" sEnv = sEnv & " <soap:Body>" sEnv = sEnv & " <GetAssetInformation xmlns=""http://support.dell.com/WebServices/"">" sEnv = sEnv & " <guid>12345678-1234-1234-1234-123456789012</guid>" 'Looks for SKU in active worksheet cell B3 sEnv = sEnv & " <applicationName>AssetService</applicationName>" sEnv = sEnv & " <serviceTags>" & Worksheets("Sheet1").Range("A2").Value & "</serviceTags>" sEnv = sEnv & " </GetAssetInformation>" sEnv = sEnv & " </soap:Body>" sEnv = sEnv & " </soap:Envelope>" ' Send SOAP Request With xmlhtp .Open "post", sURL, False .setRequestHeader "Host", "xserv.dell.com" .setRequestHeader "Content-Type", "text/xml; charset=utf-8" .setRequestHeader "SOAPAction", "http://support.dell.com/WebServices/GetAssetInformation" .setRequestHeader "Accept-encoding", "zip" .send sEnv xmldoc.LoadXML .responseText xmldoc.setProperty "SelectionNamespaces", "xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'" Set xmlElement = xmldoc.DocumentElement Worksheets("Sheet1").Range("A5").Value = .responseText Worksheets("Sheet1").Range("A3").Value = .SelectSingleNodes("//GetAssetInformationResult/Asset/AssetHeaderData/SystemModel").Text MsgBox xmlElement.SelectNodes("Body/GetAssetInformationResult/Asset/AssetHeaderData/SystemModel").Text End With Dim xmltemplatestring As String Set xmlRoot = xmldoc.DocumentElement Set xmlChildren = xmlRoot.ChildNodes For Each xmlTemplate In xmlChildren xmltemplatestring = xmltemplatestring & xmlTemplate.nodeName Next xmlTemplate MsgBox xmltemplatestring End Sub 

这两行不起作用,一般会得到运行时错误438

Worksheets("Sheet1").Range("A3").Value = .SelectSingleNodes("//GetAssetInformationResult/Asset/AssetHeaderData/SystemModel").Text MsgBox xmlElement.SelectNodes("Body/GetAssetInformationResult/Asset/AssetHeaderData/SystemModel").Text

xmltemplatestring返回soap:Body

A5包含以下文字:

 <?xml version="1.0" encoding="utf-8"?><soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><soap:Body><GetAssetInformationResponse xmlns="http://support.dell.com/WebServices/"><GetAssetInformationResult><Asset><AssetHeaderData><ServiceTag>7Y5WR4J</ServiceTag><SystemID>poweredge-r510</SystemID><Buid>202</Buid><Region>Europe</Region><SystemType>PowerEdge</SystemType><SystemModel>PowerEdge R510</SystemModel><SystemShipDate>2010-05-30T19:00:00-05:00</SystemShipDate></AssetHeaderData><Entitlements><EntitlementData><ServiceLevelCode>NU</ServiceLevelCode><ServiceLevelDescription>ND ProSupport EndUser On-Site Extended with Dates</ServiceLevelDescription><Provider /><StartDate>2015-05-30T00:00:00</StartDate><EndDate>2016-05-31T00:00:00</EndDate><DaysLeft>316</DaysLeft><EntitlementType>Active</EntitlementType></EntitlementData><EntitlementData><ServiceLevelCode>NU</ServiceLevelCode><ServiceLevelDescription>ND ProSupport EndUser On-Site Extended with Dates</ServiceLevelDescription><Provider /><StartDate>2013-05-30T00:00:00</StartDate><EndDate>2015-05-31T00:00:00</EndDate><DaysLeft>0</DaysLeft><EntitlementType>Expired</EntitlementType></EntitlementData><EntitlementData><ServiceLevelCode>ND</ServiceLevelCode><ServiceLevelDescription>Next Business Day Onsite</ServiceLevelDescription><Provider /><StartDate>2010-05-30T00:00:00</StartDate><EndDate>2013-05-31T00:00:00</EndDate><DaysLeft>0</DaysLeft><EntitlementType>Expired</EntitlementType></EntitlementData><EntitlementData><ServiceLevelCode>4I</ServiceLevelCode><ServiceLevelDescription>4H ProSupport For IT Mission Extended with Dates</ServiceLevelDescription><Provider /><StartDate>2010-05-30T00:00:00</StartDate><EndDate>2013-05-31T00:00:00</EndDate><DaysLeft>0</DaysLeft><EntitlementType>Expired</EntitlementType></EntitlementData></Entitlements></Asset></GetAssetInformationResult></GetAssetInformationResponse></soap:Body></soap:Envelope> 

任何帮助,将不胜感激!

你可以通过子节点recursion地find它

例如

 Set xmlElement = xmldoc.DocumentElement Set SystemModel = FindChild(xmlElement, "SystemModel") Worksheets("Sheet1").Range("A3").Value = SystemModel.Text Function FindChild(ByVal rootNode As Object, ByVal nodeName) As Object Dim node As Object Dim tempFind As Object For Each node In rootNode.ChildNodes If rootNode.nodeName = nodeName Then Set tempFind = node Else If node.nodeTypeString = "element" Then If tempFind Is Nothing Then Set tempFind = FindChild(node, nodeName) End If End If End If Next node Set FindChild = tempFind End Function 

其中FindChild(xmlElement,“SystemModel”)传递XML节点和nodeName以进行search

此外,XML中有多个名称空间,因此您需要包含它们,并确保它们的前缀允许定义正确的path。 这应该工作

 Private Sub CommandButton1_Click() Dim xmldoc As New MSXML2.DOMDocument60 xmldoc.LoadXML .responseText xmldoc.setProperty "SelectionNamespaces", _ "xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/' " & _ "xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " & _ "xmlns:xsd='http://www.w3.org/2001/XMLSchema' " & _ "xmlns:mm='http://support.dell.com/WebServices/'" Set xmlElement = xmldoc.DocumentElement Set SystemModel = xmlElement.SelectSingleNode("//soap:Body/mm:GetAssetInformationResponse/mm:GetAssetInformationResult/mm:Asset/mm:AssetHeaderData/mm:SystemModel") Worksheets("Sheet1").Range("A3").Value = SystemModel.Text MsgBox SystemModel.Text End Sub 

SelectSingleNodes不是一个现有的方法,并且SelectNodes返回一个节点列表,所以你必须在尝试访问它的属性之前select该列表的特定成员。

尝试:

  xmlElement.SelectNodes( _ "Body/GetAssetInformationResult/Asset/AssetHeaderData/SystemModel")(0).Text