Reading a web service from VBA

See more:

.NET

VBA

service

web

As the title suggests, I am attempting to read XML from a web service using VBA in Access 2010. I've managed to correctly construct the XML in the service so that the fields are created correctly, but attempting to view the data throws this error:

Run-time error ';-2147467259 (80004005)' :

Data provider or other service returned an E_FAIL status.

The closest I've got to any help is this link: http://support.microsoft.com/kb/259555[^] but no matter what I change the encoding to on the service and in Access I get the same result.

I've seen some people say it can't be done but having got this close I'll be annoyed to say the least if that turns out to be the case.

Any advice would be appreciated!

Public Function ServiceToRecordset(ServiceName As String, pCol As Collection) As ADODB.Recordset
    Dim oStream As ADODB.Stream
    Dim result As String
    Dim Output As String
    Set oStream = New ADODB.Stream
    Dim xDom As MSXML2.DOMDocument
    Dim oRecordset As ADODB.Recordset

    oStream.Type = adTypeText
    oStream.Charset = "iso-8859-1"

    oStream.Open
    oStream.WriteText GetServiceInfo(ServiceName, pCol), stWriteLine

    Set xDom = New DOMDocument
    oStream.Position = 0
    Output = ReplaceChars(oStream.ReadText) 'Switches > to ", etc

    xDom.loadXML Output

    oStream.Close
    Set oStream = Nothing

    'Gets the xml I'm interested in from inside the envelope
    xDom.loadXML xDom.childNodes(1).childNodes(0).childNodes(0).childNodes(0).childNodes(0).XML

    Set oRecordset = New ADODB.Recordset
    oRecordset.Open xDom

    Set ServiceToRecordset = oRecordset
    Set oRecordset = Nothing
End Function

Public Function GetServiceInfo(ServiceName As String, parameters As Collection) As String
    Dim objXML           As MSXML2.XMLHTTP
    Dim strURL           As String
    Dim intCount         As Integer
    Dim paramInfo        As SOAPData
    Const REQUESTSTART   As String = "<?xml version=""1.0"" encoding=""utf-8""?><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/""><soap:Body>"
    Const REQUESTEND     As String = "</soap:Body></soap:Envelope>"
    Dim xmlBlock         As String
    Dim sEnv             As String
            
    Set objXML = New MSXML2.XMLHTTP
   
    strURL = "http://localhost/MyTestService.asmx?op=" & ServiceName
        
    sEnv = REQUESTSTART
    sEnv = sEnv & "<" & ServiceName & " xmlns=""http://myservice.net/"">"
    
    For intCount = 1 To parameters.Count
        Set paramInfo = parameters(intCount)
        xmlBlock = "<" & paramInfo.Name & ">" & paramInfo.Value & "</" & paramInfo.Name & ">"
        sEnv = sEnv & xmlBlock
    Next
        
    sEnv = sEnv & "</" & ServiceName & ">" & REQUESTEND
        
    With objXML
        .Open "post", strURL, False
        .setRequestHeader "Host", "localhost"
        .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
        .setRequestHeader "Accept-encoding", "zip"
        .send sEnv
    End With
   
    GetServiceInfo = objXML.responseText
    Set objXML = Nothing
    
End Function