Question

我已经使用VBA代码从SOAP Web服务返回了响应。我想从响应中获取节点值。我在论坛中查看了一些示例，但似乎没有一个完全符合我的要求。与我的情况类似的最接近的线程如下：

VBA Excel Macro SelectSingleNode returns nothing

如何开始的任何示例或帮助将不胜感激。

VBA中的XML请求示例：

'Set Reference to Microsoft XML, v6.0
Option Explicit

Dim responseText As String
Dim sURL As String
Dim sEnv As String
Dim xmlhtp As New MSXML2.XMLHTTP
Dim xmlDoc As New DOMDocument
Dim webserviceSOAPActionNameSpace

Sub test()

sURL = "http://soap.qacomplete.smartbear.com/psWS.asmx?wsdl"

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 & "<Bugs_LoadByCriteria xmlns=""http://www.pragmaticsw.com/"">"
sEnv = sEnv & "<AuthenticationData>"
sEnv = sEnv & "<AppCode>agSP</AppCode>"
sEnv = sEnv & "<DeptId>81842</DeptId>"
sEnv = sEnv & "<ProjId>92553</ProjId>"
sEnv = sEnv & "<UserId>147280</UserId>"
sEnv = sEnv & "<PassCode>Password1</PassCode>"
sEnv = sEnv & "</AuthenticationData>"
sEnv = sEnv & "<Condition><![CDATA[<Conditions xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'"
sEnv = sEnv & " xmlns:xsd='http://www.w3.org/2001/XMLSchema' Operation='opEQU'>"
sEnv = sEnv & "<Items Type='tField'>"
sEnv = sEnv & "<Value xsi:type='xsd:string'>Custom11</Value>"
sEnv = sEnv & "</Items>"
sEnv = sEnv & "<Items Type='tString'>"
sEnv = sEnv & "<Value xsi:type='xsd:string'>Finance</Value>"
sEnv = sEnv & "</Items>"
sEnv = sEnv & "</Conditions>]]>"
sEnv = sEnv & "</Condition>"
sEnv = sEnv & "</Bugs_LoadByCriteria>"
sEnv = sEnv & "</soap:Body>"
sEnv = sEnv & "</soap:Envelope>"

    With xmlhtp

    webserviceSOAPActionNameSpace = "http://www.pragmaticsw.com/"

        .Open "POST", sURL, False

        .setRequestHeader "POST", "http://soap.qacomplete.smartbear.com/psWS.asmx HTTP/1.1"
        .setRequestHeader "Content-Type", "application/soap+xml; charset=UTF-8"
        .setRequestHeader "SOAPAction", webserviceSOAPActionNameSpace & "Bugs_LoadByCriteria"
        .setRequestHeader "Accept-encoding", "zip"

        .send sEnv

        xmlDoc.LoadXML .responseText

End With

End Sub

示例响应XML：

<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>
      <Bugs_LoadByCriteriaResponse xmlns="http://www.pragmaticsw.com/">
         <Bugs_LoadByCriteriaResult>
            <Bug>
               <CustomFieldNames>
               <BugId>3253017</BugId>
               <Title>DM78 Customer and DM25 Vendor Master Data - default criteria</Title>
               <StatusCode>Closed</StatusCode>
               <SeverityCode>Minor</SeverityCode>
               <PriorityCode>P3</PriorityCode>
               <IssueCode>Data</IssueCode>
               <ResolutionCode>Fixed</ResolutionCode>
               <AssigneeUserId>137784</AssigneeUserId>
               <OpenedBy>136840</OpenedBy>
               <ClosedBy>137748</ClosedBy>
               <ResolvedBy>137748</ResolvedBy>
            </Bug>
         </Bugs_LoadByCriteriaResult>
      </Bugs_LoadByCriteriaResponse>
   </soap:Body>
</soap:Envelope>

Answer 1

@AmiKhan的回答从问题回答。

Option Explicit

'Set Reference to Microsoft XML, v6.0
Dim DefectsCount As Integer
Dim wsDefects As Worksheet
Dim varTargetCycle As String
Dim list As IXMLDOMNodeList
Dim responseText As String
Dim sURL As String
Dim sEnv As String
Dim xmlhtp As New MSXML2.xmlHttp
Dim xmlDoc As New DOMDocument
Dim webserviceSOAPActionNameSpace

Sub GetDefects(PNum, PSize)

    sURL = "http://soap.qacomplete.smartbear.com/psWS.asmx?wsdl"
    varTargetCycle = Range("TargetCycle").Value

    sEnv = "<?xml version =""1.0"" encoding=""utf-8""?>"
    sEnv = sEnv & "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" xmlns:prag=""http://www.pragmaticsw.com/"">"
    sEnv = sEnv & "<soap:Body>"
    sEnv = sEnv & "<prag:Bugs_LoadByCriteria>"
    sEnv = sEnv & "<prag:AuthenticationData>"
    sEnv = sEnv & "<prag:AppCode>agSP</prag:AppCode>"
    sEnv = sEnv & "<prag:DeptId>81842</prag:DeptId>"
    sEnv = sEnv & "<prag:ProjId>92553</prag:ProjId>"
    sEnv = sEnv & "<prag:UserId>" & V1USER & "</prag:UserId>"
    sEnv = sEnv & "<prag:PassCode>" & V1PASS & "</prag:PassCode>"
    sEnv = sEnv & "</prag:AuthenticationData>"
    sEnv = sEnv & "<prag:Condition><![CDATA[<Conditions xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'"
    sEnv = sEnv & " xmlns:xsd='http://www.w3.org/2001/XMLSchema' Operation='opEQU'>"
    sEnv = sEnv & "<Items Type='tField'>"
    sEnv = sEnv & "<Value xsi:type='xsd:string'>Custom17</Value>"
    sEnv = sEnv & "</Items>"
    sEnv = sEnv & "<Items Type='tString'>"
    sEnv = sEnv & "<Value xsi:type='xsd:string'>" & varTargetCycle & "</Value>"
    sEnv = sEnv & "</Items>"
    sEnv = sEnv & "</Conditions>]]></prag:Condition>"

    sEnv = sEnv & "<prag:Sorting>Title</prag:Sorting>"
    sEnv = sEnv & "<prag:PageSize>" & PSize & "</prag:PageSize>"
    sEnv = sEnv & "<prag:PageNumber>" & PNum & "</prag:PageNumber>"

    sEnv = sEnv & "</prag:Bugs_LoadByCriteria>"
    sEnv = sEnv & "</soap:Body>"
    sEnv = sEnv & "</soap:Envelope>"

    With xmlhtp

        webserviceSOAPActionNameSpace = "http://www.pragmaticsw.com/"

        .Open "POST", sURL, False

        .setRequestHeader "POST", "http://soap.qacomplete.smartbear.com/psWS.asmx HTTP/1.1"
        .setRequestHeader "Content-Type", "application/soap+xml; charset=UTF-8"
        .setRequestHeader "SOAPAction", webserviceSOAPActionNameSpace & "Bugs_LoadByCriteria"
        .setRequestHeader "Accept-encoding", "zip"

        .send sEnv

        xmlDoc.LoadXML .responseText
        'MsgBox .responseText
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim Node As IXMLDOMNode
        Dim LRow As Integer

        Set list = xmlDoc.SelectNodes("//Bugs_LoadByCriteriaResponse/Bugs_LoadByCriteriaResult/Bug")

        Set wsDefects = Sheet2

        Dim xmlnodelist As MSXML2.IXMLDOMNodeList
        Dim xnode As MSXML2.IXMLDOMNode

        DefectsCount = list.Length

        With wsDefects

            LRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

            For Each Node In list
                Dim strBugValue As String
                Dim strStatusCode As String
                Dim strSeverity As String
                Dim strPriority As String
                Dim strIssue As String
                Dim strReso As String

                On Error Resume Next             'if null
                strBugValue = Node.SelectSingleNode("BugId").Text
                strStatusCode = Node.SelectSingleNode("StatusCode").Text
                strSeverity = Node.SelectSingleNode("SeverityCode").Text
                strPriority = Node.SelectSingleNode("PriorityCode").Text
                strIssue = Node.SelectSingleNode("IssueCode").Text
                strReso = Node.SelectSingleNode("ResolutionCode").Text

                .Cells(LRow, 1).Value = strBugValue
                .Cells(LRow, 2).Value = strStatusCode
                .Cells(LRow, 3).Value = strSeverity
                .Cells(LRow, 4).Value = strPriority
                .Cells(LRow, 5).Value = strIssue
                .Cells(LRow, 6).Value = strReso

                LRow = LRow + 1
            Next Node
        End With
        Set xmlhtp = Nothing
        Set xmlDoc = Nothing
    End With
End Sub

使用VBA从SOAP响应中获取节点值

1 个答案: