Often applications must integrate data managed by other applications or that comes from other DataBases.

 

To obtain this result and retrieve informations by other applications one of the solutions is to do a HTTP Request and managed the Response, that could be send back in different types such as XML or JSon. Here I expose the solution to managed a XML Response.

 

This is the code:

 

'***********************************************************

'                                   MAIN START

'***********************************************************

'Variable Declaration

Dim bolResponseHTTP_XMLWriter   'boolean variable

bolResponseHTTP_XMLWriter = execHTTPReq_XMLFileWriting("GET", _ 

                           "http://URLToCall/example?par1=val1&par2=val2, _

              false, _

   "user", _ 

   "password", _ 

   "c:\temp\myXMLTest.xml")

 

if bolResponseHTTP_XMLWriter then

    msgbox "File Creation OK"

 else

   msgbox "Error"

end if

 

'***********************************************************

'                                     MAIN END

'***********************************************************

 

'**************************************************************

'FUNCTION - THERE ARE 2 FUNCTIONS, See both 

'**************************************************************   

'Function that contains these parameters:

' - method: GET [POST/PUT/HEAD/DELETE/CONNECT/OPTIONS]   --- STRING

' - address: URL to call   ---  STRING

' - asyncCall: True/False  --- BOOLEAN

' - user:   user for the authentication   --- STRING  (only if necessary)

' - password: user's password  --- STRING (only if necessary)

'Return the HTTP response in text format

'*****************************************************************

Function execHTTPReq(method, address, asyncCall, user, password)

Dim objSrvHTTP, res

 

'res will contain the HTTP response

res = ""

 

'object creation to send HTTP request 

set objSrvHTTP = CreateObject("Msxml2.ServerXMLHTTP.6.0") 

 

'I do the open method to set parameters with this arguments:

        'sending method,

        'the URL to call,  

        'asyncronous as method call

        'user and password if necessary

 

if Not(user="") then

objSrvHTTP.open method, address, asyncCall, user, password

 else

    objSrvHTTP.open method, address, asyncCall

end if

 

 

'HTTP Request Sending

objSrvHTTP.send

 

'Check if the call is ok testing the status.

if objSrvHTTP.status = 200 then

   'Load in res the result of the HTTP Request

   res = objSrvHTTP.responseText

else

   res = "ERROR"

   msgbox "Error on HTTP Request for " & objSrvHTTP.statusText,vbCritical + vbSystemModal,"Error"

end if

 

 

set objSrvHTTP = nothing

 

'return of the result

execHTTPReq = res

 

End Function

 

 

'Execution of the HTTP Request and Write of the XML (only for GET method with XML Return Response)

'The Function returns a boolean value

Function execHTTPReq_XMLFileWriting(method, address, asyncCall, user, password, fileName)

Dim strContainer, res, objXML

res = false

strContainer = (method, address, asyncCall, user, password)

if strContenuto="" then

execHTTPReq = res

Exit Function

end if

 

'MS XML DOM 

set objXMLDoc=CreateObject("Msxml2.DOMDocument")

objXMLDoc.async = false

'XML Response Loading 

objXMLDoc.loadXML(strContainer)

 

on error resume next

err.clear

objXMLDoc.save(fileName)

if err.number = 0 then

res = true

 else

        msgbox "Attention! The writing of the file " & fileName & " has not been done because of " & err.description & "!!!", vbCritical + vbSystemModal, "Error On XML Writing"

end if

 

set objXMLDoc = nothing

execHTTPReq_XMLFileWriting = res

 

End Function

'**************************************************************

 

Pag:   <<    <    >    >>