Easy Macro 4: Encontrar las coordenadas de una dirección.

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.