msmidts
asked on
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</Userna me>
<Password>Password</Passwo rd>
<Email>info@domain.be</Ema il>
<UserPassword>Password2</U serPasswor d>
<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></RemoteAdd ress>
<AgreeConditions>1</AgreeC onditions>
</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</ke y>
<value xsi:type="soapenc:string"> 1</value>
</item>
- <item>
<key xsi:type="soapenc:string" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">CustomerI D</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/">UserPassw ord</key>
<value xsi:type="soapenc:string" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">Password2 </value>
</item>
</SubscribeReturn>
</SubscribeResponse>
</soapenv:Body>
</soapenv:Envelope>
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</Userna
<Password>Password</Passwo
<Email>info@domain.be</Ema
<UserPassword>Password2</U
<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></RemoteAdd
<AgreeConditions>1</AgreeC
</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">
<value xsi:type="soapenc:string">
</item>
- <item>
<key xsi:type="soapenc:string" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">CustomerI
<value xsi:type="soapenc:int" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">1587849</
</item>
- <item>
<key xsi:type="soapenc:string" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">UserPassw
<value xsi:type="soapenc:string" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">Password2
</item>
</SubscribeReturn>
</SubscribeResponse>
</soapenv:Body>
</soapenv:Envelope>
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)
ASKER
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
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
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
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
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</Em ail>" & _
"<UserPassword>Password2</ UserPasswo rd>" & _
"<NewPassword></NewPasswor d>" & _
"<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</Phon e>" & _
"<Homepage>http://www.domain.be</Homepage>" & _
"<RemoteAddress></RemoteAd dress>" & _
"<AgreeConditions>1</Agree Conditions >"
If Not TransferDataSOAP(wRequest, wResult) Then
MsgBox "Error during the transfer."
Else
ProcessResult wResult
End If
End Sub
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</Em
"<UserPassword>Password2</
"<NewPassword></NewPasswor
"<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</Phon
"<Homepage>http://www.domain.be</Homepage>" & _
"<RemoteAddress></RemoteAd
"<AgreeConditions>1</Agree
If Not TransferDataSOAP(wRequest,
MsgBox "Error during the transfer."
Else
ProcessResult wResult
End If
End Sub
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
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
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
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
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.selec tSingleNod e("/soapen v:Envelope /soapenv:B ody/Subscr ibeRespons e/Subscrib eReturn")
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
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.selec
If oResponseNode Is Nothing Then
MsgBox "Wrong format???"
Exit Sub
End If
'Look for the result code.
Set oNode = GetValueFor(oResponseNode,
If oNode Is Nothing Then
MsgBox "No result!"
Exit Sub
End If
If oNode.nodeTypedValue = 0 Then
Set oNode = GetValueFor(oResponseNode,
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
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("va lue")
End If
Set GetValueFor = oNode
End 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
If Not oNode Is Nothing Then
'Found! now retrieve the associated value element
Set oNode = oNode.selectSingleNode("va
End If
Set GetValueFor = oNode
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you.
This is, of course, perfect and working!
Thanks again
Marion
This is, of course, perfect and working!
Thanks again
Marion
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_T
'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