locked
VBA Web Services XML .responseXML parse RRS feed

  • Question

  • I am working with MS Access 2010 VBA.  My goal is to pass a set of variables to a Web Service and consume the corresponding Web Service XML response file.  I am successful creating the initial XML message.  I am also able to see the return message in the ".responseText".  I am confused on how to work with the SelectSingleNode and binding to the XML responseXML file correctly, to extract the values I wish to pursue.

    Below are the files that I am working with.

    XML (Web Service response file)

    <soap:Envelope xmlns:soap="envelope" xmlns:xsi="XMLSchema-Instance" xmlns:xsd="XMLSchema">
       <soap:Body>
          <AuthResponse xmlns="webservices">
             <AuthResult><![CDATA[<?xml version="1.0" encoding="utf-8"?><ConfigReturn xmlns:xsi="XMLSchema-Instance" xmlns:xsd="w3.org/2001/XMLSchema"><Success>true</Success><ErrorCode>0</ErrorCode><ErrorMessage/><ServerUrl>http://KTSRV1</ServerUrl><Token>thisISaTOKENfromKWIKTAGmsaccess</Token><FTPURL>RDOC-KT\MSSQL</FTPURL></ConfigReturn>]]></AuthResult>
          </AuthResponse>
       </soap:Body>
    </soap:Envelope>

    VBA Private Sub

    Private Sub newKT_WebService_Click()
        Dim xmlhttpRequest As New MSXML2.xmlhttp
        Dim xmlhttpResponse As New MSXML2.DOMDocument
        Dim vNamedItem As Object
       
        Dim URL As String
        Dim envelope As String
        Dim responseTextVAR As String
       
        URL = "Configuration.asmz?WSDL"
        envelope = "<soapenv:Envelope xmlns:soapenv=""envelope"" xmlns:web=""webservices"">"
        envelope = envelope & " <soapenv:Header/>"
        envelope = envelope & " <soapenv:Body>"
        envelope = envelope & " <web:Auth>"
        envelope = envelope & " <web:CallingId>" & "1234" & "</web:CallingId>"
        envelope = envelope & " <web:token>" & "thisISaTOKENfromKWIKTAGmsaccess" & "</web:token>"
        envelope = envelope & " <web:domain>" & "</web:domain>"
        envelope = envelope & " <web:userName>" & "USER1" & "</web:userName>"
        envelope = envelope & " <web:password>" & "PASSWORDTEST" & "</web:password>"
        envelope = envelope & " </web:Auth>"
        envelope = envelope & " </soapenv:Body>"
        envelope = envelope & " </soapenv:Envelope>"
       
        MsgBox envelope
       
        With xmlhttpRequest
            .Open "POST", URL, False
            .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
            .send envelope
           
            MsgBox .responseText
           
            Set xmlhttpResponse = xmlhttpRequest.responseXML
           
            Set vNamedItem = xmlhttpResponse.SelectSingleNode("//AuthResponse/AuthResult/Token")
            responseTextVAR = vNamedItem.NodeValue
                 
        End With
     
        MsgBox responseTextVAR
       
    End Sub

    The code that I am struggling with is the syntax for writing the "SelectSingleNode" and how to parse the XML response file.


    Wednesday, July 17, 2013 9:09 PM

Answers

All replies

  • Hi Jason,

    If you want to know how to parse XML file in VBA, you may have a look at the following links:

    Putting XML to Work

    http://msdn.microsoft.com/en-us/library/office/aa163921(v=office.10).aspx

    Reading XML Files in VBA

    http://dailydoseofexcel.com/archives/2009/06/16/reading-xml-files-in-vba/

    Good day.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    • Marked as answer by Dummy yoyo Friday, July 26, 2013 10:16 AM
    Friday, July 19, 2013 7:25 AM
  • Hi Jason,

    I temporarily marked the reply as answer and you can unmark it if it provides no help.
    Please feel free to let us know if you have any concern.

    Thanks for your understanding and have a nice day.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Friday, July 26, 2013 10:16 AM
  • After a bunch of experimenting I cobbled together a solution for this question.   The first thing to keep in mind with this solution is that I make an assumption with the return messages that I receive from the web service.  The assumption I had to make was that the parent/child relationships were not going to get me to the detail of the data.  Instead, I needed to treat the responses as if there were long strings.  I then used string functions to parse the response strings to acquire the data.

    This isn't always going to be the case.  It is something that a person needs to play with to determine if the XML response is formatted well enough to be recognized in the parent/child functionality. 

    Below is the code that I used to call the web service by XML message followed by the code that I used receive the response XML message and parse the data. 

    One last note I did use a utility SoapUI to create test messages and view the responses, to get a better understanding of the data that was returned.

    Public Sub KTWebCallCreateReservation(wsKTDrawer, wsKTRequiredTags)

       Dim xmlhttpRequest As New MSXML2.xmlhttp
        Dim xmlhttpResponse As New MSXML2.DOMDocument
        Dim xmlhttpRoot As MSXML2.IXMLDOMNode
        Dim xmlhttpToken As MSXML2.IXMLDOMNode
        Dim xmlhttpAttribute As MSXML2.IXMLDOMNamedNodeMap
        Dim xmlhttpTokenValue As MSXML2.IXMLDOMNode
               
        Dim vNamedItem As Object
       
        Dim URL As String
        Dim envelope As String
        Dim responseTextVAR As String
        Dim StrPosn1 As Integer
        Dim StrPosn2 As Integer
        Dim StrPosnLength1 As Integer
        Dim StrVar1 As String
        Dim StrVar2 As String
        Dim StrVar3 As String
        Dim StrVar4 As String
       
        Dim strSQL As String
        Dim rstUser As New ADODB.Recordset
        Dim cnn As New ADODB.Connection
           
        Dim VarCallingID As String
        Dim VarToken As String
        Dim VarUserID As String
        Dim VarUserPW As String
        Dim VarCompanyID As String
        Dim VarBarcode As String
        Dim VarDrawerName As String
        Dim VarSiteName As String
           
        'SELECT THE USER AND PASSWORD HERE.
        Set cnn = CurrentProject.Connection
        VarUserID = Forms!Main_Menu.txtusername
       
        strSQL = "SELECT Password FROM RDOC_Users WHERE User_Name = '" & VarUserID & "';"
        rstUser.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
        If rstUser.RecordCount > 0 Then
            VarUserPW = rstUser.Fields("Password").Value
        Else
            MsgBox "User Not Found"
        End If
           
           
        'PRESET CALLINGID AND COMPANYID
        VarCallingID = "1d69fb6d-6572-4b9c-b06b-f2851cd77bf2"
        VarCompanyID = "RA400077"
        VarDrawerName = wsKTDrawer
        VarSiteName = "HOMESITE"
       
       
        'Create KT Web Services Message to acquire Security Token
        URL = "http://IPADDRESS/apiv2/Configuration.asmx?WSDL"
        envelope = "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:web=""http://homeserver.com/webservices/"">"
        envelope = envelope & " <soapenv:Header/>"
        envelope = envelope & " <soapenv:Body>"
        envelope = envelope & " <web:Auth>"
        envelope = envelope & " <web:CallingId>" & VarCallingID & "</web:CallingId>"
        envelope = envelope & " <web:userName>" & VarUserID & "</web:userName>"
        envelope = envelope & " <web:password>" & VarUserPW & "</web:password>"
        envelope = envelope & " </web:Auth>"
        envelope = envelope & " </soapenv:Body>"
        envelope = envelope & " </soapenv:Envelope>"
       
       
        'Send AUTH message and retrieve TOKEN value
        With xmlhttpRequest
            .Open "POST", URL, False
            .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
            .send envelope
           
            Set xmlhttpResponse = xmlhttpRequest.responseXML
            Set xmlhttpRoot = xmlhttpResponse.DocumentElement
           
            responseTextVAR = xmlhttpRoot.Text
        End With
     
     
        'Identify the TOKEN value within the returned AUTH message string
        StrPosn1 = InStr(responseTextVAR, "<Token>")
        StrPosn2 = InStr(responseTextVAR, "</Token>")
        StrPosnLength1 = Len("<Token>")
        VarToken = Mid(responseTextVAR, (StrPosn1 + StrPosnLength1), (StrPosn2 - (StrPosn1 + StrPosnLength1)))
     
        
        'Acquire the User's (VarUserName) next Barcode
        URL = "http://IPADDRESS/apiv2/Barcode.asmx?WSDL"
        envelope = "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:web=""http://homeserver.com/webservices/"">"
        envelope = envelope & " <soapenv:Header/>"
        envelope = envelope & " <soapenv:Body>"
        envelope = envelope & " <web:RetrieveNext>"
        envelope = envelope & " <web:CompanyID>" & VarCompanyID & "</web:CompanyID>"
        envelope = envelope & " <web:UserName>" & VarUserID & "</web:UserName>"
        envelope = envelope & " <web:SecurityToken>" & VarToken & "</web:SecurityToken>"
        envelope = envelope & "<web:Barcode></web:Barcode>"
        envelope = envelope & " <web:CallingId>" & VarCallingID & "</web:CallingId>"
        envelope = envelope & " </web:RetrieveNext>"
        envelope = envelope & " </soapenv:Body>"
        envelope = envelope & " </soapenv:Envelope>"
       
       
        'send RETRIEVENEXT message
        With xmlhttpRequest
            .Open "POST", URL, False
            .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
            .send envelope
       
            Set xmlhttpResponse = xmlhttpRequest.responseXML
            Set xmlhttpRoot = xmlhttpResponse.DocumentElement
       
            responseTextVAR = xmlhttpRoot.Text
        End With
       
       
        'Identify the BARCODE value within the returned RETRIEVENEXT message string
        StrPosn1 = InStr(responseTextVAR, "<Number>")
        StrPosn2 = InStr(responseTextVAR, "</Number>")
        StrPosnLength1 = Len("<Number>")
        VarBarcode = Mid(responseTextVAR, (StrPosn1 + StrPosnLength1), (StrPosn2 - (StrPosn1 + StrPosnLength1)))
        'Adds the value VarBarcode to the local table variable
        BarCode = VarBarcode
          
          
        'call the the form PageCount input box.
        PageCount = InputBox("Your Next Barcode is: " & BarCode & vbCrLf & vbCrLf & "Please Enter Page Count: ", "Page Count", 0)
       
        If PageCount = "" Then
           MsgBox "Tag/Barcode Reservation is cancelled."
           Canceled = 1
           Exit Sub
        Else
          If IsNumeric(PageCount) Then
             Canceled = 0
          Else
             MsgBox "The Page Count you entered is not Valid." & vbCrLf & vbCrLf & "Tag/Barcode Reservation is cancelled."
             Canceled = 1
             Exit Sub
          End If
        End If
       
        'Asign Barcode Reservation - based on Users Required Fields values
        URL = "http://IPADDRESS/apiv2/Document.asmx?WSDL"
        envelope = "<?xml version=""1.0"" encoding=""utf-8""?>"
        envelope = envelope & "<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"">"
        envelope = envelope & "<soap:Body><Index xmlns=""http://homeserver.com/webservices/"">"
        envelope = envelope & "<CompanyID>" & VarCompanyID & "</CompanyID>"
        envelope = envelope & "<UserName>" & VarUserID & "</UserName>"
        envelope = envelope & "<SecurityToken>" & VarToken & "</SecurityToken>"
        envelope = envelope & "<DrawerName>" & VarDrawerName & "</DrawerName>"
        envelope = envelope & "<Barcode>" & VarBarcode & "</Barcode>"
        envelope = envelope & wsKTRequiredTags
        envelope = envelope & "<ExpectedPageCount>" & PageCount & "</ExpectedPageCount>"
        envelope = envelope & "<VeritagEmailAddressList />"
        envelope = envelope & "<VeritagFromEmailAddress />"
        envelope = envelope & "<NotifyDate />"
        envelope = envelope & "<GMTOffset>-5</GMTOffset>"
        envelope = envelope & "<NotifySubject />"
        envelope = envelope & "<NotifyBody />"
        envelope = envelope & "<AttachLink>false</AttachLink>"
        envelope = envelope & "<AttachImage>false</AttachImage>"
        envelope = envelope & "<NotifyEmailAddressList />"
        envelope = envelope & "<NotifyEmailCCList />"
        envelope = envelope & "<NotifyFromEmailAddress />"
        envelope = envelope & "<AddToExisting>false</AddToExisting>"
        envelope = envelope & "<OverwriteExisting>false</OverwriteExisting>"
        envelope = envelope & "<ImageFileType />"
        envelope = envelope & "<AutoRotate>true</AutoRotate>"
        envelope = envelope & "<RotateDegrees>0</RotateDegrees>"
        envelope = envelope & "<Deskew>false</Deskew>"
        envelope = envelope & "<CallingId>1d69fb6d-6572-4b9c-b06b-f2851cd77bf2</CallingId>"
        envelope = envelope & "<site>" & VarSiteName & "</site>"
        envelope = envelope & "</Index>"
        envelope = envelope & "</soap:Body>"
        envelope = envelope & "</soap:Envelope>"
       
       
        'send INDEX message
        With xmlhttpRequest
            .Open "POST", URL, False
            .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
            .send envelope
       
            Set xmlhttpResponse = xmlhttpRequest.responseXML
            Set xmlhttpRoot = xmlhttpResponse.DocumentElement
           
            responseTextVAR = xmlhttpRoot.Text
        End With
       
        MsgBox ("The RESERVATION is complete.")
       
       
    End Sub



    Friday, September 6, 2013 9:59 PM