Call Webservice from VB6

I needed to call a webservice I built in C# from an old application made in VB6. Using SOAP was not an option, so I decided to use MSXML2 to prepare and send my own XML code. MSXML2 comes with IE6, and most users already have it installed, but just in case, I used late binding for MSXML2. Comments preceed each block of code. See comments in Command1_Click method for further details.

Private Sub Command1_Click()
' Start Internet Explorer and type in the url of your webservice page
' i.e.: http://localhost/myweb/mywebService.asmx
' In that page, click on the link to the method you want to call from your application
' Select in upper POST section the xml code from
' Copy this into the strXml variable, escape all quotes and replace "string" your parameter value
' Copy the url to your webservice page (asmx) to the strUrl variable
' Copy the SOAPAction value to the strSoapAction variable

Dim strSoapAction As String
Dim strUrl As String
Dim strXml As String
Dim strParam As String

txtOutput.Text = ""
strParam = "MyParameterString"
strUrl = "http://localhost/myweb/mywebService.asmx"
strSoapAction = "http://tempuri.org/MyMethod"


strXml = "" & _
"" & _
"" & _
"" & _
"" & strParam & "" & _
"" & _
"" & _
""

' Call PostWebservice and put result in text box
Debug.Print PostWebservice(strUrl, strSoapAction, strXml)

End Sub


Private Function PostWebservice(ByVal AsmxUrl As String, ByVal SoapActionUrl As String, ByVal XmlBody As String) As String
Dim objDom As Object
Dim objXmlHttp As Object
Dim strRet As String
Dim intPos1 As Integer
Dim intPos2 As Integer

On Error GoTo Err_PW

' Create objects to DOMDocument and XMLHTTP
Set objDom = CreateObject("MSXML2.DOMDocument")
Set objXmlHttp = CreateObject("MSXML2.XMLHTTP")

' Load XML
objDom.async = False
objDom.loadXML XmlBody

' Open the webservice
objXmlHttp.open "POST", AsmxUrl, False

' Create headings
objXmlHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
objXmlHttp.setRequestHeader "SOAPAction", SoapActionUrl

' Send XML command
objXmlHttp.send objDom.xml

' Get all response text from webservice
strRet = objXmlHttp.responseText

' Close object
Set objXmlHttp = Nothing

' Extract result
intPos1 = InStr(strRet, "Result>") + 7
intPos2 = InStr(strRet, " If intPos1 > 7 And intPos2 > 0 Then
strRet = Mid(strRet, intPos1, intPos2 - intPos1)
End If

' Return result
PostWebservice = strRet

Exit Function
Err_PW:
PostWebservice = "Error: " & Err.Number & " - " & Err.Description

End Function