A pesar de que este tema es viejo, con las actualizaciones de API de Google Maps (cof cof dinero es dinero), la utilización de una macro en Excel para encontrar las coordenadas de una dirección tuvo que modificarse un poco, y aquí podrás ver el como.
1. La aplicación.
Nominatim es una aplicación libre que funciona de una manera similar a Maps, esta menos indexada a las busquedas pero aun asi es demasiado buena. Puedes verla en línea aquí https://nominatim.openstreetmap.org/.
2. La función.
Ahora pasemos al código.
Lo primero que necesitamos es activar una librería que nos servirá para conectar con la estructura XML de la aplicación. Microsoft XML 6.0 (o la 3.0 dependiendo tu versión).

Puedes descargar el libro para la libreria XML6.0 con la función aquí.
Puedes descargar el libro para la libreria XML3.0 con la función aquí.
Con esto activo, podremos acceder a las propiedades XML de la pagina, por lo que crearemos un nuevo documento con la siguiente línea
Dim xDoc As New MSXML2.DOMDocument60
Esa linea nos permitirá después crear una variable de búsqueda con el código
Dim loc As MSXML2.IXMLDOMElement
Y despues, solo sera cuestion de tomar los elementos que necesitamos (latitud y longitud) para conocer la geocoordenada. El código queda de la siguiente manera:
Function NominatimGeocode(address As String) As String
Application.Caller.Font.ColorIndex = xlNone
Dim xDoc As New MSXML2.DOMDocument60
xDoc.async = False
xDoc.Load ("https://nominatim.openstreetmap.org/search?format=xml&q=" + address)
If xDoc.parseError.ErrorCode <> 0 Then
Application.Caller.Font.ColorIndex = vbErr
NominatimGeocode = xDoc.parseError.reason
Else
xDoc.SetProperty "SelectionLanguage", "XPath"
Dim loc As MSXML2.IXMLDOMElement
Set loc = xDoc.SelectSingleNode("/searchresults/place")
If loc Is Nothing Then
Application.Caller.Font.ColorIndex = vbErr
NominatimGeocode = xDoc.XML
Else
Application.Caller.Font.ColorIndex = vbOK
NominatimGeocode = loc.getAttribute("lat") & "," & loc.getAttribute("lon")
End If
End If
End Function
3. Como acomodar los datos en la tabla.
En la tabla del archivo que puedes descargar, veras que la estructura necesaria para la búsqueda es la siguiente.

Después, solo concatenamos la información separándolo por espacios con cualquier método que prefieras y aplicamos la función que hemos creado al concatenado.
=NominatimGeocode(F2)
¡Y listo! Tienes las coordenadas de longitud y latitud de la dirección.
4. Reversa de la función.
Adicional, podemos hacer una búsqueda de la dirección con la latitud y longitud. Aquí abajo te dejo el código.
Function NominatimReverseGeocode(lat As Double, lng As Double) As String
On Error GoTo eh
Dim xDoc As New MSXML2.DOMDocument60
xDoc.async = False
Url = "https://nominatim.openstreetmap.org/reverse?lat=" + CStr(lat) + "&lon=" + CStr(lng)
xDoc.Load ("https://nominatim.openstreetmap.org/reverse?lat=" + CStr(lat) + "&lon=" + CStr(lng))
If xDoc.parseError.ErrorCode <> 0 Then
Application.Caller.Font.ColorIndex = vbErr
NominatimReverseGeocode = xDoc.parseError.reason
Else
xDoc.SetProperty "SelectionLanguage", "XPath"
Dim loc As MSXML2.IXMLDOMElement
Set loc = xDoc.SelectSingleNode("/reversegeocode/result")
If loc Is Nothing Then
Application.Caller.Font.ColorIndex = vbErr
NominatimReverseGeocode = xDoc.XML
Else
Application.Caller.Font.ColorIndex = vbOK
NominatimReverseGeocode = loc.Text
End If
End If
Exit Function
eh:
Debug.Print Err.Description
End Function
Modificación del código por región
Gracias a Stewart Cardona por el siguiente dato revisado 😀
Yo mero
Si tu sistema utiliza la coma como separador de decimales por default, puede que te encuentres con el siguiente error.
Para solucionarlo, es necesario modificar las líneas que llaman a los parámetros de longitud y latitud de la siguiente manera:
En vez de usar
Url = "https://nominatim.openstreetmap.org/reverse?lat=" + CStr(lat) + "&lon=" + CStr(lng) xDoc.Load ("https://nominatim.openstreetmap.org/reverse?lat=" + CStr(lat) + "&lon=" + CStr(lng))
Usaremos
Url = "https://nominatim.openstreetmap.org/reverse?lat=" + Replace(CStr(lat),",",".") + "&lon=" + Replace(CStr(lng),",",".") xDoc.Load ("https://nominatim.openstreetmap.org/reverse?lat=" + Replace(CStr(lat),",",".") + "&lon=" + Replace(CStr(lng),",","."))
El código complete se vera de la siguiente manera.
Function NominatimReverseGeocode(lat As Double, lng As Double) As String On Error GoTo eh Dim xDoc As New MSXML2.DOMDocument60 xDoc.async = False Url = "https://nominatim.openstreetmap.org/reverse?lat=" + Replace(CStr(lat),",",".") + "&lon=" + Replace(CStr(lng),",",".") xDoc.Load ("https://nominatim.openstreetmap.org/reverse?lat=" + Replace(CStr(lat),",",".") + "&lon=" + Replace(CStr(lng),",",".")) If xDoc.parseError.ErrorCode <> 0 Then Application.Caller.Font.ColorIndex = vbErr NominatimReverseGeocode = xDoc.parseError.reason Else xDoc.SetProperty "SelectionLanguage", "XPath" Dim loc As MSXML2.IXMLDOMElement Set loc = xDoc.SelectSingleNode("/reversegeocode/result") If loc Is Nothing Then Application.Caller.Font.ColorIndex = vbErr NominatimReverseGeocode = xDoc.XML Else Application.Caller.Font.ColorIndex = vbOK NominatimReverseGeocode = loc.Text End If End If Exit Function eh: Debug.Print Err.Description End Function
A pesar de no ser tan exacto como el API de Google, funciona muy bien. Cualquier duda nos leemos abajo.
Buenas tardes me puedes ayudar como puedo ingresar una dirección de Colombia y que me devuelva el código posta
Hola Carlos.
Entra a la pagina de Nomnatim y ve la forma en que se escriben las direcciones buscando directamente alguna de Colombia.
Ya con eso, puedes ver lo que necesitas.
Saludos!
Buenas Tardes. super lo que haz diseñado consulta como implemento este código pero en access?
Saludos.
Hola Enyerbe.
Te mentiría si te diera una respuesta :S
Espero alguien por aqui pueda ayudarte.
Saludos.
Se podra ocupar google maps, en vez de open street?? quedo atentos, saludos
Hola Gonzalo.
Es posible y mejor ocupar Google maps, el unico inconveniente es que la API es de pago 😀
Si tienes para contratarlo, te lo recomiendo ampliamente.
Saludos!
Hola, use el macro y parece que corre, el problema es que arroja «Error en la descarga del recurso solicitado.» tengo activa la librería XML6.0 y estoy usando excel 2019. saludos
«
Hola Manuel.
Al parecer este error surge por dos motivos:
1. Parece que existe un problema al usarlo en una red empresarial o con algún tipo de seguridad. Si es el caso, pruébala fuera de la red de oficina.
2. Puede deberse también a que tu maquina utilice algún símbolo de separador de decimales distinto. Para probar eso introduce dentro del código lo siguiente y mándame el resultado a svallejo@excelcute.com para poder ayudarte más:
Para la funcion NominatimReverseGeocode introducelo despues de la linea que inicia con URL=…
InputBox «Toma este valor y depositalo en tu buscador para que puedas ver el error», , Url
Para la funcion NominatimGeocode introducelo despues de la linea que inicia con Dim XDoc
InputBox «Toma este valor y depositalo en tu buscador para que puedas ver el error», , «https://nominatim.openstreetmap.org/search?format=xml&q=» + address
Hermano crees que me podrías enviar la libreria XML6.0 ya que al querer descargarla me marca error
Hola Alejandro!

Esa libreria ya viene instalada en tu Excel por default, no hay nada que descargar.
Si no encuentras esa, puedes utilizar tambien la librería XML3.0.
Cualquier duda puedes escribirme a svallejo@excelcute.com y por ahi lo resolvemos.
Saludos!
hola buenos dias ya guarde el archivo con el ejemplo, pero al colocarn en la PC me arroja no puede encontrar el objeto, hay algo que tenga que configurar adicional en la pc.
Hola David buenos días.
Revisa tener activada la librería Microsoft XML 6.0 en tu Excel para poder utilizar la herramienta.
Te dejo una imagen por aquí o escríbeme a svallejo@excelcute.com para poder ayudarte más personal.