receive the xmldocument response from a SOAP call

with the help of experts on this exchange i managed to cobble together this code
it does work almost, but it produces a text file and not an xml document file, or i am not smart enough to load the xml document.
So any help would be appreciated

Sub plireader()
'On Error Resume Next

'CEMgetattendance -  CLETracker
'DEV_getattendance -152413
 

Dim strrequest As String
Dim objhttp As Object
    strXmlToSend = "<company>CLETracker</company>"
    '    strXmlToSend = "<company>CLETracker</company>"

webserviceurl = "https://www.pli.edu/public/CEM/Service.asmx"

 Set objhttp = CreateObject("Msxml2.XMLHTTP.6.0")
MsgBox "send now"
  strrequest = "<?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>" _
               & "<CEMgetAttendence xmlns=""http://www.pli.edu/public/CEM/"">" _
               & "<company>CLETracker</company>" _
               & "</CEMgetAttendence>" _
               & "</soap:Body>" _
               & "</soap:Envelope>"
Dim resp As String

MsgBox strrequest
objhttp.Open "POST", webserviceurl, False
objhttp.setRequestHeader "SOAPAction", "http://www.pli.edu/public/CEM/Service.asmx?op=CEMgetAttendence"

objhttp.setRequestHeader "Content-Type", "text/xml"
objhttp.send (strrequest)
  ' resp = http.HttpGetText(url)

MsgBox "response is:" & objhttp.responseText
 'xmlDoc = objhttp.responseXML
   ' Set objhttp = Nothing
   ' Set xmlDoc = Nothing
    DEMO_TARGET_PATH = "e:\AccessData\Tempxml3.xml"
    If objhttp.STATUS = "200" Then
MsgBox "status = 200"
'save the file:
 resp = objhttp.responseText

 iFileNumber = FreeFile
Open DEMO_TARGET_PATH For Output As #iFileNumber
Print #iFileNumber, DEMO_TARGET_PATH, resp
Close #iFileNumber
End If
'Call LoadDocument(DEMO_TARGET_PATH)

End Sub
durickAsked:
Who is Participating?
 
Ryan ChongCommented:
this worked for me:

Sub plireader()
    'On Error Resume Next
    
    'CEMgetattendance -  CLETracker
    'DEV_getattendance -152413
    
    
    Dim strrequest As String
    Dim objhttp As Object
    strXmlToSend = "<company>CLETracker</company>"
    
    webserviceurl = "https://www.pli.edu/public/CEM/Service.asmx"
    
    Set objhttp = CreateObject("Msxml2.XMLHTTP.6.0")
    
    strrequest = "<?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>" _
                & "<CEMgetAttendence xmlns=""http://www.pli.edu/public/CEM/"">" _
                & "<company>CLETracker</company>" _
                & "</CEMgetAttendence>" _
                & "</soap:Body>" _
                & "</soap:Envelope>"
    Dim resp As String
    
    objhttp.Open "POST", webserviceurl, False
    
    objhttp.setRequestHeader "SOAPAction", "http://www.pli.edu/public/CEM/Service.asmx?op=CEMgetAttendence"
    objhttp.setRequestHeader "Content-Type", "text/xml"
    
    objhttp.send
    
    DEMO_TARGET_PATH = "e:\AccessData\Tempxml3.xml"
    
    If objhttp.Status = "200" Then
        'save the file:
        resp = objhttp.responseText
        
        iFileNumber = FreeFile
        Open DEMO_TARGET_PATH For Output As #iFileNumber
            Print #iFileNumber, resp
        Close #iFileNumber
    End If
    
    'Call LoadDocument(DEMO_TARGET_PATH)

End Sub

Open in new window

0
 
Fabrice LambertFabrice LambertCommented:
resp = objhttp.responseText
Replace with:
resp = objhttp.responseXML.xml

Open in new window


Side notes:
iFileNumber = FreeFile
 Open DEMO_TARGET_PATH For Output As #iFileNumber
 Print #iFileNumber, DEMO_TARGET_PATH, resp
 Close #iFileNumber
 End If
 'Call LoadDocument(DEMO_TARGET_PATH)
I prefer using FSO and Texstream objects, like in the code snipet below:
Public Sub saveToFile(ByVal path As String, ByRef data As String)
On Error GoTo Error
    Const ForWriting = 2
    
    Dim FSO As Object       '// Scripting.FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim file As Object      '// Scripting.TextStream
    Set file = FSO.OpenTextFile(path, ForWriting, True)
    file.Write data
    file.Close
    Set file = Nothing
    Set FSO = Nothing
Exit Sub
Resume
Error:
    If Not (file Is Nothing) Then
        file.Close
        Set file = Nothing
    End If
    If Not (FSO Is Nothing) Then
        Set FSO = Nothing
    End If
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub

Open in new window

0
 
Ryan ChongCommented:
suggest to accept comment(s) as the answer(s), which the suggested posted by me is working fine.
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.