UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Geocode - Google Maps, Access 2013    
 
   
genoma111
post Jan 15 2014, 10:33 PM
Post#1



Posts: 2,018
Joined: 2-June 09
From: Bogotá - Colombia


This is a very simple example of how to retrieve the coordinates for a location using GeoCode and passing them to Google Maps without the Google API.
Developed in Access 2013 x64, uses an ActiveX Microsoft WebBrowser Control for compatibility with versions older than 2010.
The complete code of the application is this:
Heading:
CODE
Option Compare Database
Option Explicit
Private Const cGeoCodeWeb As String = "http://maps.googleapis.com/maps/api/geocode/xml?address="
Private Const cGooMapsQry As String = "https://maps.google.com/?q="

Button: cmdGetCoordinates_Click
CODE
'-------------------------------------------------------------------------------------------
' Name:         cmdGetCoordinates_Click
' Purpose:      Gets the coordinates for a location using GeoCode.
' Description:  Send a request to GeoCode, receives the response text, extracts the
'               latitude and longitude data and fills the corresponding textboxes.
' Author:       Diego F.Pereira-Perdomo
' Date:         Jan-15-2014
'-------------------------------------------------------------------------------------------
Private Sub cmdGetCoordinates_Click()
    Dim strLocation As String
    Dim strGeoCode  As String
    Dim w
    
    strLocation = Me.txtLocation
    strLocation = Replace(strLocation, " ", "+")
    
    strGeoCode = cGeoCodeWeb & strLocation & "&sensor=true"
    strGeoCode = GetResponseText1(strGeoCode)
    
    w = GetLatLng(strGeoCode)
    
    Me.txtLatitude = w(0)
    Me.txtLongitude = w(1)
End Sub

Button: cmdGetMap_Click
CODE
'-------------------------------------------------------------------------------------------
' Name:         cmdGetMap_Click
' Purpose:      Gets a map from google using latitude and longitude data.
' Description:  Uses an ActiveX WebBrowser for displaying the google maps.
' Requires:     ActiveX Microsoft WebBrowser Control
'               Microsoft Internet Controls Library
' Author:       Diego F.Pereira-Perdomo
' Date:         Jan-15-2014
'-------------------------------------------------------------------------------------------
Private Sub cmdGetMap_Click()
    Dim Html    As Object
    Dim strWeb  As String
    
    strWeb = cGooMapsQry & _
             Me.txtLatitude & "+" & _
             Me.txtLongitude & "+" & _
             "+&t=h&output=embed"
            
    Set Html = Me.wbGoogleMaps.Object
        Html.Silent = True
        Html.Navigate strWeb
    Set Html = Nothing
End Sub

Function: GetResponseText1
CODE
'-------------------------------------------------------------------------------------------
' Name:         GetResponseText1
' Purpose:      Gets the content of web pages or text files from the web.
' Description:  Does not implement timeouts
' Requires:     Microsoft XML, v6.0 library
' Author:       Diego F.Pereira-Perdomo
' Date:         Jul-11-2012
'-------------------------------------------------------------------------------------------
Private Function GetResponseText1(ByVal strWeb As String) As String
    Dim xml As MSXML2.XMLHTTP60
    
    Set xml = New MSXML2.XMLHTTP60
    
        With xml
            .Open "GET", strWeb, False
            .send
            GetResponseText1 = .responseText
        End With
      
    Set xml = Nothing
    
End Function

Function: GetLatLng
CODE
'-------------------------------------------------------------------------------------------
' Name:         GetLatLng
' Purpose:      Gets the latitude and longitude data.
' Description:  Uses xPath for getting the value of the appropriate nodes.
' Requires:     Microsoft XML, v6.0 library
' Author:       Diego F.Pereira-Perdomo
' Date:         Jan-15-2014
'-------------------------------------------------------------------------------------------
Private Function GetLatLng(ByVal strXml As String) As Variant()
    Dim oXml    As MSXML2.DOMDocument60
    Dim oLat    As IXMLDOMNode
    Dim oLng    As IXMLDOMNode
    Dim w(1)
    Set oXml = New MSXML2.DOMDocument60
        With oXml
            .loadXML strXml
            Set oLat = .selectSingleNode("GeocodeResponse/result/geometry/location/lat")
            Set oLng = .selectSingleNode("GeocodeResponse/result/geometry/location/lng")
            
            If Not oLat Is Nothing And Not oLng Is Nothing Then
                w(0) = oLat.firstChild.nodeValue
                w(1) = oLng.firstChild.nodeValue
            End If
            
            Set oLat = Nothing
            Set oLng = Nothing
        End With
        
        GetLatLng = w
    Set oXml = Nothing
End Function
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    16th December 2017 - 09:03 PM