Códigos postales en Access 2010 de Google maps

Vamos a usar un web servicio REST de la Api de Google maps. Lo vamos a hacer en Access 2010 ya que cuenta con el web browser nativo para poder colocar el mapa.

En un formulario nuevo que llamaremos formZip y en vista diseño vamos a poner cinco controles de texto independientes: txtDir, txtProvincia, txtlat, txtlong y txtzip. Un botón que le llamaremos cmdZip y por último un control de explorador web (web browser) que lo llamaremos Explorador1. Todo los controles los podemos poner sin necesidad de tener el asistente de controles activo, de hecho es preferible tenerlo apagado.

Aquí es importante que leamos la documentación de google maps sobre los web servicios que la encontramos aquí:

https://developers.google.com/maps/documentation/webservices/

Y sobre todo la de codificación geográfica que es el proceso de transformar direcciones en coordenadas geográficas de latitud y longitud, donde obtendremos el código postal y éstas nos servirán para colocar el marcador en el mapa, y el de Google Static Maps que nos permite insertar la  imagen de la dirección.

Google maps codifica en utf-8 los caracteres acentuados y símbolos, así que necesitamos hacer la conversión, podemos buscar una función que lo haga o podemos hacerla nosotros, para eso tomamos prestada una de Emilio Sancha sobre acentos y la modificamos un poco (No puse Mayúsculas con acento, si lo requieren póngaselo) y la colocamos en un nuevo módulo:

Function UTF8(strTexto As String) As String
strTexto = Replace(strTexto, " ", "%20")
strTexto = Replace(strTexto, "Ñ", "%C3%91")
strTexto = Replace(strTexto, "ñ", "%C3%B1")
strTexto = Replace(strTexto, "á", "%C3%A1")
strTexto = Replace(strTexto, "à", "%C3%A0")
strTexto = Replace(strTexto, "â", "%C3%A2")
strTexto = Replace(strTexto, "ã", "%C3%A3")
strTexto = Replace(strTexto, "ä", "%C3%A4")
strTexto = Replace(strTexto, "å", "%C3%A5")
strTexto = Replace(strTexto, "è", "%C3%A8")
strTexto = Replace(strTexto, "é", "%C3%A9")
strTexto = Replace(strTexto, "ê", "%C3%AA")
strTexto = Replace(strTexto, "ë", "%C3%AB")

strTexto = Replace(strTexto, "ì", "%C3%AC")
strTexto = Replace(strTexto, "í", "%C3%AD")
strTexto = Replace(strTexto, "î", "%C3%AE")
strTexto = Replace(strTexto, "ï", "%C3%AF")

strTexto = Replace(strTexto, "ð", "%C3%B0")
strTexto = Replace(strTexto, "ò", "%C3%B2")
strTexto = Replace(strTexto, "ó", "%C3%B3")
strTexto = Replace(strTexto, "ô", "%C3%B4")
strTexto = Replace(strTexto, "õ", "%C3%B5")
strTexto = Replace(strTexto, "ö", "%C3%B6")

strTexto = Replace(strTexto, "ù", "%C3%B9")
strTexto = Replace(strTexto, "ú", "%C3%BA")
strTexto = Replace(strTexto, "û", "%C3%BB")
strTexto = Replace(strTexto, "ü", "%C3%BC")

strTexto = Replace(strTexto, ",", "%2C")
strTexto = Replace(strTexto, "ý", "%C3%BD")
strTexto = Replace(strTexto, "þ", "%C3%BE")
strTexto = Replace(strTexto, "ÿ", "%C3%BF")

strTexto = Replace(strTexto, "÷", "%C3%B7")
UTF8 = strTexto
End Function ' UTF8

Podemos guardar el módulo, e irnos al formulario, ahora vamos a comenzar con el botón en vista diseño, entramos a propiedades, en eventos, al hacer click y le damos a los tres puntos, generador de código y aceptar, y tenemos:

Private Sub cmdZip_Click()

End Sub

Primero nos tenemos que conectar a la api de Rest de google con la Librería msxml, con el XMLHttp hacemos la conexión, pedimos la información solicitada y la guardamos en un documento DOM. Así que lo primero es agregar la librería a nuestra base, en VBA en Herramientas, Referencias y buscamos Microsoft XML, v6.0 y agregamos la palomita y le damos aceptar.

Creamos las variables y el primer código que utilizaremos queda así:

Private Sub cmdZip_Click()
Dim xmlHtp As MSXML2.XMLHTTP60 ‘Para conectarnos al web servicio
Dim xmlDoc As MSXML2.DOMDocument60 ‘Para guardar el documento
Dim nodes As MSXML2.IXMLDOMNodeList ‘Para recorrer una lista de nodos
Dim node As MSXML2.IXMLDOMNode ‘Para leer un nodo
Dim sUrl As String ‘Para la url
Dim smap As String ‘Para el mapa
sUrl = "http://maps.googleapis.com/maps/api/geocode/xml?address="
sUrl = sUrl & UTF8(Me.txtDir) & "%20" & UTF8(Me.txtProvincia)
sUrl = sUrl & "&sensor=false"

Set xmlHtp = New MSXML2.XMLHTTP60
With xmlHtp
.Open "GET", sUrl, False  'Hacemos la solicitud
.send ‘Mandamos la solicitud
Set xmlDoc = New MSXML2.DOMDocument60
xmlDoc.loadXML .responseText
Debug.Print xmlDoc.XML 'Comprobamos que obtenemos respuesta
End with
End sub

Por lo pronto es todo lo que necesitamos para nuestra primera prueba, nos vamos al formulario y escribimos una dirección y debe de verse algo como esto:

Le damos click al botón y nos vamos a VBA y debemos tener en la ventana inmediata algo como esto:

Una vez que sabemos que tenemos respuesta correcta podemos continuar con el código, tenemos que crear un bucle que recorra el xml para buscar el código postal, para eso usamos XPath con ("//result/address_component/type") y nos situamos en el nodo donde se encuentre el código postal en este caso:

<address_component>
   <long_name>64000</long_name>
   <short_name>64000</short_name>
   <type>postal_code</type>
 </address_component>

Y le decimos que queremos el primer nodo hijo, que es long_name y sólo queremos el texto (64000) que tiene y después vamos a obtener la latitud y longitud, para situarlo en el mapa. El código quedaría así:

Private Sub cmdZip_Click()
Dim xmlHtp As MSXML2.XMLHTTP60 'Para conectarnos al web servicio
Dim xmlDoc As MSXML2.DOMDocument60 'Para guardar el documento
Dim nodes As MSXML2.IXMLDOMNodeList 'Para recorrer una lista de nodos
Dim node As MSXML2.IXMLDOMNode 'Para leer un nodo
Dim sUrl As String 'Para la url
Dim smap As String 'Para el mapa
sUrl = "http://maps.googleapis.com/maps/api/geocode/xml?address="
sUrl = sUrl & UTF8(Me.txtDir) & "%20" & UTF8(Me.txtProvincia)
sUrl = sUrl & "&sensor=false"

Set xmlHtp = New MSXML2.XMLHTTP60
With xmlHtp
.Open "GET", sUrl, False
.send
Set xmlDoc = New MSXML2.DOMDocument60
xmlDoc.loadXML .responseText
Dim szip As String

Set nodes = xmlDoc.selectNodes("//result/address_component/type")
For Each node In nodes
szip = node.Text
If szip = "postal_code" Then
txtzip = node.parentNode.firstChild.Text
End If
Next node
Me.txtlat = xmlDoc.selectSingleNode("//result/geometry/location/lat").Text
Me.txtlong = xmlDoc.selectSingleNode("//result/geometry/location/lng").Text

Debug.Print xmlDoc.XML 'Comprobamos que obtenemos respuesta
End With
End Sub

Volvemos a darle click al botón y obtenemos esto:

Ahora sólo queda agregar el mapa a nuestro control explorador y agregar el marcador a la dirección, para eso vamos a VBA y debajo de End With agregando tres líneas:

smap = "(""http://maps.googleapis.com/maps/api/staticmap?size=250x200&maptype=roadmap\&markers=color:red|label:I|"
smap = smap & Me.txtlat & "," & Me.txtlong & "&sensor=false&zoom=15"")"
debug.print smap

Volvemos al formulario y una vez más damos click al botón y nos regresamos a vba en la ventana inmediato en la parte de abajo seleccionamos la última línea y la pegamos en el explorador de internet borrándole los paréntesis y comillas que están adelante y atrás, tenemos:

(http://maps.googleapis.com/maps/api/staticmap?size=250x200&maptype=roadmap\&markers=color:red|label:I|25.6780526,-100.3266968&sensor=false&zoom=15)

Y lo dejamos así:

http://maps.googleapis.com/maps/api/staticmap?size=250x200&maptype=roadmap\&markers=color:red|label:I|25.6780526,-100.3266968&sensor=false&zoom=15

y debemos obtener algo como esto:

Básicamente ya terminamos, sólo falta agregarla al control Explorador1, tenemos que agregar un signo de = y algunas comillas así que agregamos una variable más y después se lo agregamos a nuestro control:

Dim strCS As String
strCS = "=" & smap & ""
Me.Explorador1.ControlSource = strCS

Todo el código quedó así:
Private Sub cmdZip_Click()
Dim xmlHtp As MSXML2.XMLHTTP60 'Para conectarnos al web servicio
Dim xmlDoc As MSXML2.DOMDocument60 'Para guardar el documento
Dim nodes As MSXML2.IXMLDOMNodeList 'Para recorrer una lista de nodos
Dim node As MSXML2.IXMLDOMNode 'Para leer un nodo
Dim sUrl As String 'Para la url
Dim smap As String 'Para el mapa
sUrl = "http://maps.googleapis.com/maps/api/geocode/xml?address="
sUrl = sUrl & UTF8(Me.txtDir) & "%20" & UTF8(Me.txtProvincia)
sUrl = sUrl & "&sensor=false"

Set xmlHtp = New MSXML2.XMLHTTP60
With xmlHtp
.Open "GET", sUrl, False
.send
Set xmlDoc = New MSXML2.DOMDocument60
xmlDoc.loadXML .responseText
Dim szip As String

Set nodes = xmlDoc.selectNodes("//result/address_component/type")
For Each node In nodes
szip = node.Text
If szip = "postal_code" Then
txtzip = node.parentNode.firstChild.Text
End If
Next node
Me.txtlat = xmlDoc.selectSingleNode("//result/geometry/location/lat").Text
Me.txtlong = xmlDoc.selectSingleNode("//result/geometry/location/lng").Text

'Debug.Print xmlDoc.XML 'Comprobamos que obtenemos respuesta
End With
DoEvents
smap = "(""http://maps.googleapis.com/maps/api/staticmap?size=250x200&maptype=roadmap\&markers=color:red|label:I|"
smap = smap & Me.txtlat & "," & Me.txtlong & "&sensor=false&zoom=15"")"
Debug.Print smap
Dim strCS As String
strCS = "=" & smap & ""
Me.Explorador1.ControlSource = strCS

End Sub

Y así es como se ve después de darle click:

Les dejo el archivo: