Link to home
Create AccountLog in
Avatar of Nico2011
Nico2011Flag for United Kingdom of Great Britain and Northern Ireland

asked on

XML Google Maps Issue 2

Hello,

I have the following code which works perfectly in a web browser, however, I am trying to get it to work in a VBS Script, so have removed the server. code, but it doesn't work as a VBS - perhaps I'm doing something wrong...?  I've removed the 'response.write' scripts as I'm trying to update the DB as to whether a location has been found or not...

The code is as follows:

Option Explicit

Dim SQL, RS, ID, address, objSrvHTTP, url, sensor, objXML, objLst, j, i, AddressStr, AddStrLinkBack, lat, lng, msg, DB, strConn, mesg ' , objXMLSend, objXMLReceive

'TEST DB
strconn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=userid;Password=testpassword;Initial Catalog=DBName;Data Source=IPADDRESS;"
DB.Open strconn

SQL = SQL & "select * from locations where lng = '' OR lng is NULL order by Region" 
Set RS = DB.Execute(SQL)

'Response.Write "<locations>"
While NOT RS.EOF
	'Response.Write "<location>"
	ID = RS("ID")
	'Response.Write "<id>" & ID & "</id>"

  address = RS("location") & "," & RS("Region") & "," & RS("Country")

  Set objSrvHTTP = CreateObject("Msxml2.ServerXMLHTTP.6.0")
   
   url = "http://maps.google.com/maps/api/geocode/xml?address="
   sensor = "&sensor=false"
   url = url & URLEncode(address) & sensor

   objSrvHTTP.open "GET", url, false
   objSrvHTTP.send
   Set objXML = objSrvHTTP.responseXML
   
   If objXML.parseError.errorCode <> 0 Then
	 msg = "Error Found"
   Else

	j = 0
	i = 0
	lng = ""
	lat = ""
	AddressStr = ""
	AddStrLinkBack = ""

	Set objLst = objXML.selectNodes("//formatted_address")
	For i = 0 to (objLst.length - 1)
		If objLst.item(i).nodeName = "formatted_address" Then
		  AddressStr = objLst.item(i).text
		  j = j + 1
		  url = "searchaddress.asp?address=" & objLst.item(i).text
		  AddStrLinkBack = AddStrLinkBack & "<p><a href=""" & url & """>" & objLst.item(i).text & " lng: " & lng & " lat: " & lat & "</a></p>"
		End If
	Next
	Set objLst = Nothing

	Set objLst = objXML.selectNodes("//location/*")
	For i = 0 to (objLst.length - 1)

		If objLst.item(i).nodeName = "lat" then
			lat = objLst.item(i).text
		end if
		If objLst.item(i).nodeName = "lng" then
			lng = objLst.item(i).text
		end if
		
	Next
	Set objLst = Nothing

	If lng <> "" AND lat <> "" then
		SQL = "Update Locations set NotFound=0 where ID='" & ID & "'"
	else
		SQL = "Update Locations set NotFound=1 where ID='" & ID & "'"
	End if
	mesg = mesg & SQL & "<BR>"
	'DB.Execute(SQL)

   End If

	Set objSrvHTTP = Nothing
	'Set objXMLSend = Nothing
	'Set objXMLReceive = Nothing
	Set objXML = Nothing

	'Response.Write "</location>"
	RS.MoveNext
Wend
'Response.Write "</locations>"

RS.Close
Set RS = Nothing
DB.Close
Set DB = Nothing

Open in new window


Thanks in advance!
Avatar of Robert Schutt
Robert Schutt
Flag of Netherlands image

The one place left where you can delete 'Server' as well is
CreateObject("Msxml2.ServerXMLHTTP.6.0")

Open in new window

Not sure if that could make a difference but worth a try, the object should exist. Haven't tried the code yet, but will do so in a minute...
Ah, there is a problem earlier than that. Before the DB.Open you need to create that object (was probably in the include file before).
Set DB = CreateObject("ADODB.Connection")

Open in new window

and you need a vbs implementation for URLEncode.
' found on: http://dwarf1711.blogspot.nl/2007/10/vbscript-urlencode-function.html

Function URLEncode(ByVal str)
	Dim strTemp, strChar Dim intPos, intASCII
	strTemp = ""
	strChar = ""
	For intPos = 1 To Len(str)
	intASCII = Asc(Mid(str, intPos, 1))
	If intASCII = 32 Then
		strTemp = strTemp & "+"
	ElseIf ((intASCII < 123) And (intASCII > 96)) Then
		strTemp = strTemp & Chr(intASCII)
	ElseIf ((intASCII < 91) And (intASCII > 64)) Then
		strTemp = strTemp & Chr(intASCII)
	ElseIf ((intASCII < 58) And (intASCII > 47)) Then
		strTemp = strTemp & Chr(intASCII)
	Else
		strChar = Trim(Hex(intASCII))
		If intASCII < 16 Then
			strTemp = strTemp & "%0" & strChar
		Else
			strTemp = strTemp & "%" & strChar
		End If
	End If
	Next
	URLEncode = strTemp
End Function

Open in new window

Avatar of Nico2011

ASKER

Hi Robert - no go...

I copied everything you suggested, and it still won't play ball...!
What happens? I placed some MsgBox calls in the script and it does its job nicely. Do you want to update lat/lng in the database? And/or need to write out some logging maybe?
I get an error (0x1) in Wndows Scheduler.  Ideally, yes I'd like to update the DB - and get a message letting me know when it's completed, but that's not important.  I don't need to see anything if it runs quietly in the background!  Could yu send me your exact code and I'll see if the issue's with the server please?
ASKER CERTIFIED SOLUTION
Avatar of Robert Schutt
Robert Schutt
Flag of Netherlands image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Thanks Robert - I'm going to mark this as complete and post again if it still doesn't work, but as you've tested it, the question has to all extents and purposes, been answered!
Thank you!