TexasSwede
texasswede@gmail.com
  • About this blog
  • My Website
  • My Resume
  • XML Export Tool
  • Photos

Monthly Archives: April 2009

Get latitude and longitude for an address

Posted on April 13, 2009 by Karl-Henry Martinsson Posted in Old Blog Post Leave a comment

Recently my boss asked me to come up with a way to show certain information on a map of some kind, and after doing some research I decided to simply create a KML file and use Google Earth. In order to create the KML file, I needed latitude and longitude of each address I was going to display. I found a couple of different free services, and I decided to use the one from Google.

The Google Geocode service is using a REST API, so it was easy to write some code to send address and retrieve XML with (among other things) latitude and longitude. An additional benefit is that the address get check and modified, so if the ZIP is off, or the name of the street is not “Street” but “Drive”, the correct values get returned.

You need tosign up to get your own key from Google, but it is free.

Today I decided to write a small class to do this lookup, so now I can add this to any program I write. Below is the code for the script library, as well as a small code sample how to call it. Enjoy!

Update: I have updated the code below to the latest version, as of March 5, 2013.

Dim geodata As GeoData
Set geodata = New GeoData("6363 North State Highway 161", "Irving", "tx", "")
If geodata.IsValid Then 
  Msgbox geodata.Street & Chr$(13) & geodata.City & ", " & geodata.State & " " & geodata.ZIP,, _ 
  "Accuracy = " & geodata.AccuracyMsgbox "Lat: " & geodata.Latitude & " Longitude: " & geodata.Longitude
End If

And here is the class, I suggest to put it in a script library.
 

Option Public
Option Declare

Class GeoData
  Private GeoString As String
  Public street As String
  Public city As String
  Public zip As String
  Public state As String
  Public latitude As String
  Public longitude As String
  Public errmsg As String
  Public warnmsg As String

  Public Sub New(streetStr As String, cityStr As String, stateStr As String, zipStr As String)
    Dim httpObject As Variant
    Dim mapsKey As String
    Dim mapsURL As String
    Dim address As String  
    Dim retries As Integer
    Dim httpURL As String
    Dim returncode As String
    Dim coordinates As String
    Dim ret As Integer
    Dim xmladdress As String
    Dim addarray As Variant
    Dim success As Integer

    retries = 0    
    errmsg = ""
    warnmsg = ""
    '*** Use Win32 COM object to do HTTP calls
    Set httpObject = CreateObject("MSXML2.ServerXMLHTTP")
    mapsKey = ""
    mapsUrl = "http://maps.google.com/maps/geo?q="
    address = streetStr & ", " & cityStr & ", " & stateStr & " " & zipStr
    httpURL = mapsURL & address & "&output=xml"
    success = False
    Do
      '*** After the two first calls, introduce a 1 second delay between calls
      If retries>1 Then
        Sleep 1    
      End If
      retries = retries + 1
      Call httpObject.open("GET", httpURL, False)
      Call httpObject.send()
      GeoString = Left$(httpObject.responseText,16000)
      returncode = GetGeoValue("code")
      If returncode = "200" Then
        success = True
        errmsg = ""
      ElseIf returncode = "500" Then
        errmsg ="[Google GeoCode Error " & returncode & "] - " _
        "A geocoding or directions request could not be successfully processed, " _
        "yet the exact reason for the failure is unknown."
        latitude = ""
        longitude = ""
        street = streetStr
        zip = zipStr
        city = cityStr
        state = stateStr
        success = True
      ElseIf returncode = "601" Then
        errmsg ="[Google GeoCode Error " & returncode & "] - An empty address was specified."
        latitude = ""
        longitude = ""
        street = streetStr
        zip = zipStr
        city = cityStr
        state = stateStr
        success = True
      ElseIf returncode = "602" Then
        errmsg ="[Google GeoCode Error " & returncode & "] - " _ 
        "No corresponding geographic location could be found for the specified address, " _
        "possibly because the address is relatively new, or because it may be incorrect."
        latitude = ""
        longitude = ""
        street = streetStr
        zip = zipStr
        city = cityStr
        state = stateStr
        success = True
      ElseIf returncode = "603" Then
        errmsg ="[Google GeoCode Error " & returncode & "] - " _
        "The geocode for the given address or the route for the given directions query " _
        "cannot be returned due to legal or contractual reasons."
        latitude = ""
        longitude = ""
        street = streetStr
        zip = zipStr
        city = cityStr
        state = stateStr
        success = True
      ElseIf returncode = "610" Then
        errmsg ="[Google GeoCode Error " & returncode & "] - The given key is either " _
        "invalid or does not match the domain for which it was given."
        latitude = ""
        longitude = ""
        street = streetStr
        zip = zipStr
        city = cityStr
        state = stateStr
        success = True
      ElseIf returncode = "620" Then
        errmsg ="[Google GeoCode Error " & returncode & "] - The given key has gone over the requests " _
        "limit in the 24 hour period or has submitted too many requests in too short a period of time."
        latitude = ""
        longitude = ""
        street = streetStr
        zip = zipStr
        city = cityStr
        state = stateStr
        success = True
      ElseIf retries >= 10 Then
        errmsg ="[Google GeoCode Error " & returncode & "] - " _
        "The geocoding function timed out." & Chr$(13) & _
        "This usually indicate a problem with the internet connection or the geocode server, " & _
        "or that the suite number is on the first address line, confusing the server."
        latitude = ""
        longitude = ""
        street = streetStr
        zip = zipStr
        city = cityStr
        state = stateStr
        success = True
      End If
    Loop Until success = True
    If returncode = "200" Then
      coordinates = GetGeoValue("coordinates")
      latitude = Left$(coordinates, InStr(coordinates,",")-1)
      longitude = Mid$(coordinates, Len(latitude)+2, InStr(Len(latitude)+2,coordinates,",")-Len(latitude)-2)
      street =GetGeoValue("ThoroughfareName")  
      zip = GetGeoValue("PostalCodeNumber")
      city = GetGeoValue("LocalityName")
      state = GetGeoValue("AdministrativeAreaName")
      xmladdress = GetGeoValue("address")
      If street = "" Or zip="" Then
        warnmsg ="[Warning] - The street address could not be verified." & Chr$(13) & _
        "Existing value will be saved." & Chr$(13) & "Please verify that address is correct."
        street = streetStr
        latitude = ""
        longitude = ""
      ElseIf city = "" Then
        If state <> "" Then
          addarray = Split(xmladdress,", ")
          city = addarray(UBound(addarray)-2)
          zip = Right$(addarray(UBound(addarray)-1),5)
        End If
      End If
      If UCase(state)<>UCase(stateStr) Then  ' Different state?
        warnmsg  = "[Warning] - The address returned seems to be very different from the one submitted." & _
        Chr$(13) & "Address submitted: " & Chr$(13) & streetStr & Chr$(13) & cityStr & ", " & stateStr & _
        " " & zipStr  & Chr$(13) & "Address returned: " & Chr$(13) & street & Chr$(13) & city & ", " & _ 
        state & " " & zip
        street = streetStr
        zip = zipStr
        city = cityStr
        state = stateStr
        latitude = ""
        longitude = ""
      End If
      If city = "" Then
        warnmsg ="[Warning] - The city could not be verified." & Chr$(13) & _
        "Existing value will be saved." & Chr$(13) & "Please verify that address is correct."
        city = cityStr
        latitude = ""
        longitude = ""
      End If
    End If
  End Sub

  Public Function Accuracy() As Integer
    Dim startpos As Long
    Dim endpos As Long
    If IsValid = False Then
      Accuracy = 0
      Exit Function
    End If
    startpos = InStr(LCase(GeoString),|accuracy="|) + 10 
    endpos = InStr(startpos, LCase(GeoString), |"|) 
    If endpos < startpos Then
      Accuracy = 0     
    Else
      Accuracy = CInt(FullTrim(Mid$(GeoString,startpos, endpos - startpos)))     
    End If  
  End Function      

  Public Function HasAddInfo(address As String) As Integer    
    If InStr(LCase(address),"apt")>0 Then
      HasAddInfo = True
    ElseIf InStr(LCase(address),"apartment ")>0 Then      
      HasAddInfo = True      
    ElseIf InStr(LCase(address),"suite ")>0 Then      
      HasAddInfo = True
    ElseIf InStr(LCase(address),"ste ")>0 Then      
      HasAddInfo = True
    ElseIf InStr(LCase(address)," #")>0 Then      
      HasAddInfo = True
    ElseIf InStr(LCase(address),", ")>0 Then      
      HasAddInfo = True
    Else
      HasAddInfo = False
    End If
  End Function

  Public Function IsValid() As Integer
    If GeoString = "" Then
      IsValid = False
    Else
      IsValid = True
    End If
  End Function

  Public Function GetGeoValue(tag As String) As String
    Dim startpos As Long
    Dim endpos As Long
    Dim tempstring As String
    If GeoString = "" Then
      GetGeoValue = ""
      Exit Function
    End If
    startpos = InStr(LCase(GeoString),"< " & LCase(tag) & ">") + Len(tag) 
    endpos = InStr(startpos, LCase(GeoString), "") 
    If endpos < startpos Then
      GetGeoValue = ""
    Else
      tempstring = FullTrim(Mid$(GeoString,startpos+2, endpos - startpos - 2))
      GetGeoValue = FullTrim(Replace(tempstring,"&","&"))
    End If
  End Function

End Class

HCL Ambassador 2020

HCL Ambassador 2020

IBM Champion 2014-2020

Stack Exchange

profile for Karl-Henry Martinsson on Stack Exchange, a network of free, community-driven Q&A sites

Notes/Domino Links

  • Planet Lotus Planet Lotus
  • IBM dW Forums IBM dW Forums
  • StackOverflow StackOverflow

Recent Posts

  • Notes and Domino v12 is here!
  • NTF Needs Your Help
  • Helpful Tools – Ytria EZ Suite (part 2)
  • Busy, busy – But wait: There is help!
  • Semantic UI – An alternative to Bootstrap?

Recent Comments

  • Lotus Script Multi-thread Message Box [SOLVED] – Wanted Solution on ProgressBar class for Lotusscript
  • Viet Nguyen on Keep up with COVID-19 though Domino!
  • Viet Nguyen on Keep up with COVID-19 though Domino!
  • Mark Sullivan on Looking for a HP calculator? Look no further!
  • Lynn He on About This Blog

My Pages

  • How to write better code in Notes

Archives

  • June 2021 (1)
  • April 2021 (2)
  • March 2021 (1)
  • August 2020 (3)
  • July 2020 (2)
  • April 2020 (2)
  • March 2020 (1)
  • December 2019 (2)
  • September 2019 (1)
  • August 2019 (2)
  • July 2019 (2)
  • June 2019 (3)
  • April 2019 (2)
  • December 2018 (1)
  • November 2018 (1)
  • October 2018 (5)
  • August 2018 (2)
  • July 2018 (3)
  • June 2018 (2)
  • May 2018 (1)
  • April 2018 (2)
  • March 2018 (1)
  • February 2018 (2)
  • January 2018 (4)
  • December 2017 (3)
  • November 2017 (2)
  • October 2017 (2)
  • September 2017 (1)
  • August 2017 (2)
  • July 2017 (6)
  • May 2017 (4)
  • February 2017 (1)
  • January 2017 (2)
  • December 2016 (2)
  • October 2016 (3)
  • September 2016 (4)
  • August 2016 (1)
  • July 2016 (2)
  • June 2016 (2)
  • May 2016 (3)
  • April 2016 (1)
  • March 2016 (4)
  • February 2016 (2)
  • January 2016 (4)
  • December 2015 (3)
  • November 2015 (2)
  • October 2015 (1)
  • September 2015 (2)
  • August 2015 (1)
  • July 2015 (5)
  • June 2015 (2)
  • April 2015 (2)
  • March 2015 (3)
  • February 2015 (2)
  • January 2015 (10)
  • December 2014 (1)
  • November 2014 (3)
  • October 2014 (3)
  • September 2014 (13)
  • August 2014 (6)
  • July 2014 (5)
  • May 2014 (3)
  • March 2014 (2)
  • January 2014 (10)
  • December 2013 (5)
  • November 2013 (2)
  • October 2013 (5)
  • September 2013 (4)
  • August 2013 (7)
  • July 2013 (3)
  • June 2013 (1)
  • May 2013 (4)
  • April 2013 (7)
  • March 2013 (8)
  • February 2013 (9)
  • January 2013 (5)
  • December 2012 (7)
  • November 2012 (13)
  • October 2012 (10)
  • September 2012 (2)
  • August 2012 (1)
  • July 2012 (1)
  • June 2012 (3)
  • May 2012 (11)
  • April 2012 (3)
  • March 2012 (2)
  • February 2012 (5)
  • January 2012 (14)
  • December 2011 (4)
  • November 2011 (7)
  • October 2011 (8)
  • August 2011 (4)
  • July 2011 (1)
  • June 2011 (2)
  • May 2011 (4)
  • April 2011 (4)
  • March 2011 (7)
  • February 2011 (5)
  • January 2011 (17)
  • December 2010 (9)
  • November 2010 (21)
  • October 2010 (4)
  • September 2010 (2)
  • July 2010 (3)
  • June 2010 (2)
  • May 2010 (3)
  • April 2010 (8)
  • March 2010 (3)
  • January 2010 (5)
  • November 2009 (4)
  • October 2009 (7)
  • September 2009 (1)
  • August 2009 (7)
  • July 2009 (1)
  • June 2009 (4)
  • May 2009 (1)
  • April 2009 (1)
  • February 2009 (1)
  • January 2009 (3)
  • December 2008 (1)
  • November 2008 (1)
  • October 2008 (7)
  • September 2008 (7)
  • August 2008 (6)
  • July 2008 (5)
  • June 2008 (2)
  • May 2008 (5)
  • April 2008 (4)
  • March 2008 (11)
  • February 2008 (10)
  • January 2008 (8)

Categories

  • AppDev (9)
  • Blogging (11)
    • WordPress (5)
  • Design (5)
    • Graphics (1)
    • UI/UX (2)
  • Featured (5)
  • Financial (2)
  • Food (5)
    • Baking (3)
    • Cooking (3)
  • Generic (11)
  • History (5)
  • Hobbies (10)
    • LEGO (4)
    • Photography (4)
  • Humor (1)
  • IBM/Lotus (175)
    • #Domino2025 (14)
    • #DominoForever (8)
    • #IBMChampion (46)
    • Administration (7)
    • Cloud (7)
    • CollabSphere (8)
    • Community (47)
    • Connect (33)
    • ConnectED (12)
    • Connections (3)
    • HCL (12)
    • HCL Master (1)
    • IBM Think (1)
    • Lotusphere (46)
    • MWLUG (25)
    • Notes/Domino (97)
      • Domino 11 (7)
    • Sametime (8)
    • Verse (14)
    • Volt (2)
    • Watson (6)
  • Life (8)
  • Microsoft (7)
    • .NET (2)
    • C# (1)
    • Visual Studio (1)
  • Movies (3)
  • Old Blog Post (259)
  • Personal (23)
  • Programming (83)
    • App Modernization (11)
    • Formula (4)
    • Lotusscript (46)
    • NetSuite (4)
      • SuiteScript (3)
    • node.js (4)
    • XPages (4)
  • Reviews (9)
  • Sci-Fi (4)
  • Software (24)
    • Flight Simulator (2)
    • Games (4)
    • Open Source (2)
    • Utilities (6)
  • Technology (37)
    • Aviation (3)
    • Calculators (2)
    • Computers (6)
    • Gadgets (7)
    • Mobile Phones (7)
    • Science (3)
    • Tablets (2)
  • Travel (6)
    • Texas (2)
    • United States (1)
  • Uncategorized (15)
  • Web Development (50)
    • Frameworks (23)
      • Bootstrap (14)
    • HTML/CSS (12)
    • Javascript (32)
      • jQuery (23)

Administration

  • Log in
  • Entries feed
  • Comments feed
  • WordPress.org

Tracking

Creeper
MediaCreeper
  • Family Pictures
© TexasSwede 2008-2014