SOAP - Using VBA to send XML to WSDL

Hallo,

I would like to send a XML (subscribe.xml - see below) file to a WSDL using VBA in ACCESS 2007.
An username and password must be used
The WSDL replies with a XML file (see below)
Can you help me create this code?

Thanks, Marion

Username = "Username"
Password = "Password"

The url of the WSDL: "http://www.kapazatest.com/soap/content04.cfc?wsdl"

subscribe.xml:
 <?xml version = "1.0"?>
<env:Envelope xmlns:env="http://schemas.xmlsoap.org/soap/envelope/">
<env:Body>
<Subscribe>
<Username>Username</Username>
<Password>Password</Password>
<Email>info@domain.be</Email>
<UserPassword>Password2</UserPassword>
<NewPassword></NewPassword>
<ExternalID></ExternalID>
<Name>Mastercar</Name>
<Address>2313 Any St</Address>
<Zipcode>3500</Zipcode>
<City>Sometown</City>
<Country>be</Country>
<Language>nl</Language>
<Phone>011/xx.xx.xx</Phone>
<Homepage>http://www.someplace.be</Homepage>
<RemoteAddress></RemoteAddress>
<AgreeConditions>1</AgreeConditions>
</Subscribe>
</env:Body>
</env:Envelope>

The response I should get:
<?xml version="1.0" encoding="utf-8" ?>
- <soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
- <soapenv:Body>
- <SubscribeResponse soapenv:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
- <SubscribeReturn xsi:type="ns1:Map" xmlns:ns1="http://xml.apache.org/xml-soap">
- <item xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">
  <key xsi:type="soapenc:string">Result</key>
  <value xsi:type="soapenc:string">1</value>
  </item>
- <item>
  <key xsi:type="soapenc:string" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">CustomerID</key>
  <value xsi:type="soapenc:int" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">1587849</value>
  </item>
- <item>
  <key xsi:type="soapenc:string" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">UserPassword</key>
  <value xsi:type="soapenc:string" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">Password2</value>
  </item>
  </SubscribeReturn>
  </SubscribeResponse>
  </soapenv:Body>
  </soapenv:Envelope>
msmidtsAsked:
Who is Participating?
 
ragoranCommented:
I do hope these examples are specific enough to you help start in the right direction.

Good luck on your project

0
 
ragoranCommented:
You will need a reference to the Microsoft XML library (select the latest version you have)

Then this is a sample of the code I used in a previous project.  To process the request, you could either do it in texte, but I recommend using the XML DOM object.

In the function, the pRequest parameter is the content of the envelop.

Private Function TransferDataSOAP(pRequest As String, _
                                  ByRef pResult As String) As Boolean

   Dim oWeb As MSXML.XMLHTTPRequest 'Object
   Dim bStatus As Boolean
   Dim wMsg As String
   Dim wResult As String
   Dim wPosi As Integer
   Dim wMaxWait As Integer
   Dim wError As String
   
   On Error GoTo Proc_ERROR
   
   bStatus = False
     
   Set oWeb = New MSXML.XMLHTTPRequest  
   
   wResult = pRequest
   
   wMsg = "<?xml version=""1.0"" encoding=""utf-8""?>"
   wMsg = wMsg & vbCrLf & "<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/"">"
   wMsg = wMsg & vbCrLf & "  <soap:Body>"
   wMsg = wMsg & vbCrLf & "    <" & WEB_SERVICE_ACTION & " xmlns=""" & WEB_SERVICE_NAMESPACE & """>"
   wMsg = wMsg & vbCrLf & "<" & WEB_SERVICE_PARAM & ">" & wResult & "</" & WEB_SERVICE_PARAM & ">"
   wMsg = wMsg & vbCrLf & "</" & WEB_SERVICE_ACTION & ">"
   wMsg = wMsg & vbCrLf & "</soap:Body>"
   wMsg = wMsg & vbCrLf & "</soap:Envelope>"


   'Set up to post to our localhost server
   oWeb.Open "post", "HTTP://" & nz(wsWelcome.Range("WLCM_TEST_SERVER").Value, WEB_SERVICE_SERVER) & WEB_SERVICE_URL

   'Set a standard SOAP/ XML header for the content-type
   oWeb.setRequestHeader "Content-Type", "text/xml"
   oWeb.setRequestHeader "Content-length", Len(wResult)
   
   'Set a header for the method to be called
   oWeb.setRequestHeader "SOAPAction", WEB_SERVICE_NAMESPACE & WEB_SERVICE_ACTION
   
   'Make the SOAP call
   oWeb.send wMsg

   'Get the return value
   wPosi = 0
   wMaxWait = 120
   Do While oWeb.readyState < 4 And wPosi < wMaxWait
      Wait 1
     
      wPosi = wPosi + 1
      If wPosi >= wMaxWait Then
         If vbYes = MsgBox("This transactions is taking longer to process than expected." & vbCrLf & vbCrLf & "Do you wish to continue waiting ? ", vbQuestion + vbYesNo, APP_TITLE) Then
            wPosi = 1
         End If
      End If
   Loop

   If wPosi >= wMaxWait Then
      'waited too long
      bStatus = False
   Else
   
      wResult = oWeb.responseText
   
      'Do we got an error
      If Left(wResult, 6) = "<html>" Then
         'this is an error page
         wPosi = InStr(1, wResult, "<TITLE>")
         If wPosi > 0 Then
            wError = Mid(wResult, wPosi + 7, InStr(wPosi, wResult, "</title>") - (wPosi + 8))
         Else
            wError = "Unspecified error"
         End If
         msgbox "There was an error in the attempt to connect to the server " & vbcrlf &  "  --> " & wError
               
         bStatus = False
      Else
         
         'process the message here...
           
         bStatus = True
      End If
         
   End If
   
Proc_EXIT:
   Set oWeb = Nothing
   
   TransferDataSOAP = bStatus
   
   Exit Function
   
Proc_ERROR:

   msgbox "Unhandled Error: " & err.description
   Stop
   Resume


End Function




Public Sub Wait(nSeconds As Long)
   Dim tNow As Date
   
   tNow = Now
   Do While DateDiff("s", tNow, Now()) < nSeconds
      DoEvents
   Loop
   
End Sub
0
 
ragoranCommented:
I forgot to mention that in the previous post, many information are store in constant (all caps names) or in "global" context variable (wsWelcome.Range.. as this is from an Excel project)
0
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

 
msmidtsAuthor Commented:
Hi,

This code is not very clear to me. Could you please adapt it a bit to my problem so I can find my way in it.
Maybe a little comment on wat is happening.
Can jou give me more info about the XML dom object?

Thanks,
Marion
0
 
ragoranCommented:
Marion,

You should know that Experts Exchange is not a place to have people code your application for you.  We are here to answer specifics questions, and something nudging the requester in the right direction with an example or a pointer is the most we can do.

That said, I will break this rule (I apparently had too much time on my hand today).

In the following comments, I will post sample of code that works, based on the information you provided.  My code use Microsoft XML v 5.0 library, so you will need to add a reference to it in your project.

If you want to start using Web services, I suggest you read a good reference book about XML in general and the Microsoft DLL in particuler.  You can start here: http://msdn2.microsoft.com/en-us/library/ms256177.aspx
0
 
ragoranCommented:
Open a new module, and insert the following declaration:


Const TEST_USERID = "Username"
Const TEST_PSWORD = "Password"
Const WEB_SERVICE_URL = "http://www.kapazatest.com/soap/content04.cfc?wsdl"
Const WEB_SERVICE_ACTION = "Subscribe"



Then insert this simple sub to test the program:



Public Sub testXML()

   Dim wRequest As String
   Dim wResult As String
   
   
   wRequest = "<Username>" & TEST_USERID & "</Username>" & _
               "<Password>" & TEST_PSWORD & "</Password>" & _
               "<Email>info@domain.be</Email>" & _
               "<UserPassword>Password2</UserPassword>" & _
               "<NewPassword></NewPassword>" & _
               "<ExternalID></ExternalID>" & _
               "<Name>Mastercar</Name>" & _
               "<Address>2313 Some st</Address>" & _
               "<Zipcode>3500</Zipcode>" & _
               "<City>Someplace</City>" & _
               "<Country>be</Country>" & _
               "<Language>nl</Language>" & _
               "<Phone>011/xx.xx.xx</Phone>" & _
               "<Homepage>http://www.domain.be</Homepage>" & _
               "<RemoteAddress></RemoteAddress>" & _
               "<AgreeConditions>1</AgreeConditions>"

   If Not TransferDataSOAP(wRequest, wResult) Then
      MsgBox "Error during the transfer."
   Else
      ProcessResult wResult
   End If
   
End Sub
0
 
ragoranCommented:
This is the adapted TransferDataSoap from above.  It packaged the request, send it to the web service and wait for the reply:

Public Function TransferDataSOAP(pRequest As String, _
                                  ByRef pResult As String) As Boolean

   Dim oWeb As MSXML2.XMLHTTP30  'Object from Microsoft XML v 5.0
   Dim bStatus As Boolean
   Dim wMsg As String
   Dim wResult As String
   Dim wPosi As Integer
   Dim wMaxWait As Integer
   Dim wError As String
   
   On Error GoTo Proc_ERROR
   
   bStatus = False
     
   'Finish building the XML message
   wMsg = "<?xml version=""1.0"" encoding=""utf-8""?>"
   wMsg = wMsg & vbCrLf & "<env:Envelope xmlns:env=""http://schemas.xmlsoap.org/soap/envelope/"">"
   wMsg = wMsg & vbCrLf & "  <env:Body>"
   wMsg = wMsg & vbCrLf & "    <" & WEB_SERVICE_ACTION & ">"
   wMsg = wMsg & vbCrLf & pRequest
   wMsg = wMsg & vbCrLf & "</" & WEB_SERVICE_ACTION & ">"
   wMsg = wMsg & vbCrLf & "</env:Body>"
   wMsg = wMsg & vbCrLf & "</env:Envelope>"


   'Set up to post to our localhost server
   Set oWeb = New MSXML2.XMLHTTP30
   oWeb.Open "post", WEB_SERVICE_URL

   'Set a standard SOAP/ XML header for the content-type
   oWeb.setRequestHeader "Content-Type", "text/xml"
   oWeb.setRequestHeader "Content-length", Len(wResult)
   
   'Set a header for the method to be called
   oWeb.setRequestHeader "SOAPAction", WEB_SERVICE_ACTION
   
   'Make the SOAP call
   oWeb.send wMsg

   'Get the return value, allow the user to stop if taking too long
   wPosi = 0
   wMaxWait = 120
   Do While oWeb.readyState < 4 And wPosi < wMaxWait
      'Response not available, wait a little more
      Wait 1
     
      wPosi = wPosi + 1
      If wPosi >= wMaxWait Then
         'We waited for a long time, what does the user wants ?
         If vbYes = MsgBox("This transactions is taking longer to process than expected." & vbCrLf & vbCrLf & "Do you wish to continue waiting ? ", vbQuestion + vbYesNo) Then
            wPosi = 1
         End If
      End If
   Loop

   If wPosi >= wMaxWait Then
      'waited too long, user wants to stop
      bStatus = False
   Else
   
      wResult = oWeb.responseText
   
      'Do we got an error
      If Left(wResult, 6) = "<html>" Then
         'this is an error HTML page
         wPosi = InStr(1, wResult, "<TITLE>")
         If wPosi > 0 Then
            wError = Mid(wResult, wPosi + 7, InStr(wPosi, wResult, "</title>") - (wPosi + 8))
         Else
            wError = "Unspecified error"
         End If
         MsgBox "There was an error in the attempt to connect to the server " & vbCrLf & "  --> " & wError
               
         bStatus = False
      Else
         
         'Return the result for further processing
         pResult = wResult
         bStatus = True
      End If
         
   End If
   
Proc_EXIT:
   Set oWeb = Nothing
   
   TransferDataSOAP = bStatus
   
   Exit Function
   
Proc_ERROR:

   MsgBox "Unhandled Error: " & Err.Description
   Stop
   Resume


End Function
0
 
ragoranCommented:
You will need this simple "wait" procedure for the previous function to work:


Public Sub Wait(nSeconds As Long)
   Dim tNow As Date
   
   tNow = Now
   Do While DateDiff("s", tNow, Now()) < nSeconds
      DoEvents
   Loop
   
End Sub
back to top
0
 
ragoranCommented:
This sub process the result string using an XML DOM document.  When I run, I get a valid response but the result code is 0.  You will need to add the logic for when the result code is 1 as I don't know what you want to do with.

Public Sub ProcessResult(pResult As String)

   Dim oDom As New MSXML2.DOMDocument
   Dim oResponseNode As MSXML2.IXMLDOMNode
   Dim oNode As MSXML2.IXMLDOMNode
   
   With oDom
      'load the xml string and valide its structure
      .loadXML pResult
      If .parseError <> 0 Then
         'Something is wrong...
          MsgBox "Line: " & .parseError.Line & vbCrLf & "Char: " & .parseError.linepos & vbCrLf & _
                "Text: ...'" & Mid(.parseError.srcText, 57, 20) & "...'" & vbCrLf & "Reason: " & .parseError.reason
          Exit Sub
      End If
   End With
   
   'Search for the response node using xpath query
   Set oResponseNode = oDom.documentElement.selectSingleNode("/soapenv:Envelope/soapenv:Body/SubscribeResponse/SubscribeReturn")
   If oResponseNode Is Nothing Then
      MsgBox "Wrong format???"
      Exit Sub
   End If
   
   'Look for the result code.
   Set oNode = GetValueFor(oResponseNode, "Result")
   If oNode Is Nothing Then
      MsgBox "No result!"
      Exit Sub
   End If
   
   If oNode.nodeTypedValue = 0 Then
      Set oNode = GetValueFor(oResponseNode, "returnText")
      If oNode Is Nothing Then
         MsgBox "Return 0 but result text not found"
      Else
         MsgBox "Return 0 with text " & vbCrLf & oNode.Text
      End If
   Else
   
      'Do your processing here
     
   End If

End Sub
0
 
ragoranCommented:
Finally, this is the function to extract a specific value node.  As you will use this logic frequently, it is easier to have it in a separate function.


Public Function GetValueFor(pRootNode As MSXML2.IXMLDOMNode, pKey As String) As MSXML2.IXMLDOMNode
   
   Dim oNode As MSXML2.IXMLDOMNode
   
   'Search for the element key having the pKey value
   Set oNode = pRootNode.selectSingleNode("item[key = """ & pKey & """]")
   
   If Not oNode Is Nothing Then
      'Found! now retrieve the associated value element
      Set oNode = oNode.selectSingleNode("value")
   End If
   
   Set GetValueFor = oNode
   
End Function
0
 
msmidtsAuthor Commented:
Thank you.
This is, of course, perfect and working!
Thanks again

Marion
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.