Querying a web service with vbscript (SOAP 1.1)

Lots of different ways to do a SOAP/webservice call using visual basic scripting. This is one example we did for a client.

THIS EXAMPLE IS IN SOAP 1.1 FORMAT.

Every XML message contains namespaces to properly qualify the entities within it. In SOAP 1.1 and SOAP 1.2 specifications, each had defined its own unique namespaces to define the entities belonging to those specifications.

SOAP 1.1 : http://schemas.xmlsoap.org/soap/envelope/

SOAP 1.2 : http://www.w3.org/2003/05/soap-envelope

This code slightly varies depending on your webservice. We have noticed that many webservices return data in different formats (Json, web data, xml file, text stream). This particular web service returned data with a bunch of HTML encoding in it. So we had to use a function (see bottom of this page) to strip the HTML encoding from results.

CODE BEGINS:

'These are the variables we need

Dim strSOAP

Dim url

Dim xmlhttp

Dim response

'So now we initialize our connection to the sql server

Dim adoCon

Set adoCon = CreateObject("ADODB.Connection")

adoCon.Open "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=user;Password=password;Initial Catalog=database;Data Source=servername"

On Error Resume Next

'Step 1 generate random number.

'This web service requires a GUID to be passed to the webservice each time you issue a request (this is a security measure)

Dim pChar

pChar = "0123456789"

pCount = Len(pChar)

Dim guid

guid = ""

Randomize

For i = 1 To 20 ' password length

guid = guid & Mid( pChar, 1 + Int(Rnd * pCount), 1 )

'Now start to query the webservice

strSOAP=""

strSOAP = strSOAP & "<?xml version=" & chr(34) & "1.0" & chr(34) & " encoding=" & chr(34) & "utf-8" & chr(34) & "?>"

strSOAP=strSOAP & "<soapenv:Envelope xmlns:soapenv=" & chr(34) & "http://schemas.xmlsoap.org/soap/envelope/" & chr(34) & " xmlns:typ=" & chr(34) & "http://www.northgate-is.com/proiv/webservices/types" & chr(34) & ">"

strSOAP=strSOAP & "<soapenv:Header/><soapenv:Body><typ:GetJob>"

strSOAP=strSOAP & "<Authorization_ID>MyID</Authorization_ID>"

strSOAP=strSOAP & "<GUID>" & guid & "</GUID><pCompany_Code>TST</pCompany_Code><pDivision></pDivision><pStatus_Code></pStatus_Code>"

strSOAP=strSOAP & "<pProject_Manager></pProject_Manager><pSuperintendent></pSuperintendent><pEstimator></pEstimator>"

strSOAP=strSOAP & "<pCustomer_Code></pCustomer_Code><pCost_Center></pCost_Center><pSort_By></pSort_By>"

strSOAP=strSOAP & "</typ:GetJob>"

strSOAP=strSOAP & "</soapenv:Body></soapenv:Envelope>"

url="https://spectrum.ctr-inc.com:8482/ws/GetJob?wsdl"

set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")

xmlhttp.open "POST", url, FALSE

xmlhttp.setRequestHeader "Man","POST https://spectrum.ctr-inc.com:8482/ws/GetJob?wsdl HTTP/1.1"

xmlhttp.setRequestHeader "Host", "https://spectrum.ctr-inc.com:8482"

xmlhttp.setRequestHeader "SOAPAction", "http://spectrum.ctr-inc.com:8482/ws/GetJob"

xmlhttp.setRequestHeader "Content-type", "text/xml; charset=utf-8"

xmlhttp.setRequestHeader "Content-Length", len(strSOAP)

xmlhttp.send strSOAP

'Now let's start to deal with the response

dim fs, fname, text,count

text = htmldecode(xmlhttp.responseXml.xml)

text = replace(text,"<returnElement>","")

text = replace(text,"</returnElement>","")

'Write response to a file so we have it as an archive

'set fs = CreateObject("Scripting.FileSystemObject")

'set fname=fs.CreateTextFile("\\server\getjobresults.txt",true)

'fname.Write(text)

'fname.Close

'set fname=nothing

'set fs=nothing

'Need to count how many records are in the dataset returned

count = ubound(split(text, "</jobRecord>"))

Dim startjob, endjob, job, jobstatus, jobdescription, jobcostcenter,customer

Dim objExec, sql, jobexists

Dim rs66

Set rs66 = CreateObject("ADODB.Recordset")

Dim strsql66

'Now parse each record returned

for i=1 to count

strResponseline = split(text, "</jobRecord>")(i)

startjob=instr(strResponseLine, "<Job_Number>")

endjob = instr(strResponseLine, "</Job_Number>")

job=Mid(strResponseline,startjob+12,(endjob-startjob-12))

startjob=instr(strResponseLine, "<Status_Code>")

endjob = instr(strResponseLine, "</Status_Code>")

jobstatus=Mid(strResponseline,startjob+13,(endjob-startjob-13))

If jobstatus="A" then

jobstatus="1"

End if

If jobstatus="I" then

jobstatus="0"

End if

startjob=instr(strResponseLine, "<Job_Description>")

endjob = instr(strResponseLine, "</Job_Description>")

jobdescription=Mid(strResponseline,startjob+17,(endjob-startjob-17))

jobdescription=replace(jobdescription,"&amp;","&")

startjob=instr(strResponseLine, "<Cost_Center>")

endjob = instr(strResponseLine, "</Cost_Center>")

jobcostcenter=Mid(strResponseline,startjob+13,(endjob-startjob-13))

startjob=instr(strResponseLine, "<Customer_Code>")

endjob = instr(strResponseLine, "</Customer_Code>")

customer=Mid(strResponseline,startjob+15,(endjob-startjob-15))

'Now need to query T and E database to see if the job is already in database

jobexists=0

strsql66 = "Select * from tande_jobs where jobcode='" & job & "'"

rs66.open strsql66, adoCon

Do while not rs66.eof

jobexists=1

rs66.movenext

Loop

rs66.close

'msgbox "done"

'Note: function to strip out HTML decoding

Function HTMLDecode(sText)

Dim regEx

Dim matches

Dim match

sText = Replace(sText, """, Chr(34))

sText = Replace(sText, "<" , Chr(60))

sText = Replace(sText, ">" , Chr(62))

sText = Replace(sText, "&" , Chr(38))

sText = Replace(sText, " ", Chr(32))

Set regEx= New RegExp

With regEx

.Pattern = "&#(\d+);" 'Match html unicode escapes

.Global = True

End With

Set matches = regEx.Execute(sText)

'Iterate over matches

For Each match in matches

'For each unicode match, replace the whole match, with the ChrW of the digits.

sText = Replace(sText, match.Value, ChrW(match.SubMatches(0)))

HTMLDecode = sText

End Function