ACTUALIZACIÓN API MATRIZ DE DISTANCIAS

Hola a todos!

Hace tiempo que tenía pendiente realizar una actualización del post: API MATRIZ DE DISTANCIAS EN VBA.

Y los motivos de realizar dichos cambios se deben por una parte a la necesidad de actualizar su programación y por otra a las limitaciones actuales de trabajar con matrices para poder obtener los datos de distancia y tiempo.

No obstante, el post anterior funciona correctamente y se puede utilizar sin problema.

Dado que no solo quería limitarme crear dos funciones independientes, una para obtener el tiempo y otra para obtener la distancia entre dos puntos, también he mejorado la programación. Podemos comenzar con la primera, la función DURACION_RUTA:

Function DURACION_RUTA(Origen, Destino)
'Declaramos las variables a utilizar
Dim Url As String
Dim Consulta As String
Dim Peticion As Object
Dim Respuesta As Object
Dim iNodos As Object
'Aplicamos conversion de caracteres especiales (con la función Caracter_e) al Origen y Destino
Origen = Caracter_e(LCase(Origen))
Destino = Caracter_e(LCase(Destino))
'Componemos la url necesaria para realizar la petición de datos como una matriz
Url = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & Origen & "&destinations=" & Destino _
& "&mode=" ' por defecto la ruta es en coche, el resto de opciones serían:
'"mode=bicycling"- en bicicleta
'"mode=walking"- andando
Set Peticion = CreateObject("Microsoft.XMLHTTP")
Set Respuesta = CreateObject("Msxml2.DOMDocument.6.0")
Set iNodos = Respuesta.createNode(1, "xml", "")
'Realizamos la consulta
Peticion.Open "GET", Url, False
Peticion.send
Respuesta.LoadXML (Peticion.responseText)
Set iNodos = Respuesta.getElementsByTagName("duration")
'Extraemos la duración del viaje y le damos formato
DURACION_RUTA = Format(Trim(Mid(iNodos(0).Text, 1, InStr(iNodos(0).Text, " "))) / 86400, "h:mm ""h""")
'Liberamos memoria
Set Peticion = Nothing
Set Respuesta = Nothing
Set iNodos = Nothing
End Function

Y ahora con la función DISTANCIA_RUTA:

Function DISTANCIA_RUTA(Origen, Destino)
'Declaramos las variables a utilizar
Dim Url As String
Dim Consulta As String
Dim Peticion As Object
Dim Respuesta As Object
Dim iNodos As Object
'Aplicamos conversion de caracteres especiales (con la función Caracter_e) al Origen y Destino
Origen = Caracter_e(LCase(Origen))
Destino = Caracter_e(LCase(Destino))
'Componemos la url necesaria para realizar la petición de datos como una matriz
Url = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & Origen & "&destinations=" & Destino _
& "&mode=" ' por defecto la ruta es en coche, el resto de opciones serían:
'"mode=bicycling"- en bicicleta
'"mode=walking"- andando
Set Peticion = CreateObject("Microsoft.XMLHTTP")
Set Respuesta = CreateObject("Msxml2.DOMDocument.6.0")
Set iNodos = Respuesta.createNode(1, "xml", "")
'Realizamos la consulta
Peticion.Open "GET", Url, False
Peticion.send
Respuesta.LoadXML (Peticion.responseText)
Set iNodos = Respuesta.getElementsByTagName("distance")
'Extraemos la distancia y le damos formato
DISTANCIA_RUTA = Format(Trim(Mid(iNodos(0).Text, 1, InStr(iNodos(0).Text, " "))) / 1000, "#,##0.00 ""Km""")
'Liberamos memoria
Set Peticion = Nothing
Set Respuesta = Nothing
Set iNodos = Nothing
End Function

Como podéis observar, con estas nuevas funciones podemos obtener los datos de manera independiente, no es necesario introducir el resultado en una matriz ni mostrar los dos datos en conjunto. Además con la nueva programación trabajamos sobre la salida de datos en XML y también damos formato a la información sin necesidad de hacerlo en la hoja.

Por otra parte, en el post anterior, había escrito una función para tratar los caracteres especiales, como la ñ o las tildes. El inconveniente era que esos caracteres se tenían que escribir en varias celdas para ser consultadas por la función, lo que supone un problema si esas celdas se eliminan o la información se pasa a otra parte de la hoja (dejaría de funcionar todo). Pues bien, también he mejorado esta función:

Function Caracter_e(ByVal Cadena As String) As String
'Declaramos variables
Dim sDato As String
Dim sCadena As Long
Dim Contador As Long
Dim nItem As String
'Si encontramos un caracter especial, lo sustituimos
sCadena = Len(Cadena)
If sCadena > 0 Then
For Contador = 1 To sCadena
nItem = Mid$(Cadena, Contador, 1)
Select Case nItem
Case "Ñ"
nItem = "N"
Case "ñ"
nItem = "n"
Case "á"
nItem = "a"
Case "é"
nItem = "e"
Case "í"
nItem = "i"
Case "ó"
nItem = "o"
Case "ú"
nItem = "u"
Case "ç"
nItem = "c"
End Select
sDato = sDato & nItem
Next Contador
End If
Caracter_e = sDato
End Function

Efectivamente, lo solucionamos con un sencillo “Select Case”. Ahora la función está incorporada dentro del código sin necesidad de escribir información en la hoja.

El resultado es el siguiente:

ACTUALIZACION API MATRIZ DE DISTANCIAS

Las dos funciones generan y muestran la información correctamente. Podemos colocarlas en el lugar que queramos y sin necesidad de dar formato, el código lo hace directamente.

Y por último, en el post anterior, también había incluido una sencilla macro para generar el mapa de los datos que habíamos indicado en la hoja. Esta macro componía una url que se ejecutaba y mostraba la ruta indicada en las celdas. El inconveniente que tenía era que la referencia a las celdas estaba escrita en el código, de forma que si era necesario aumentar o reducir el número de celdas, era necesario modificar la macro.

Pues bien, finalmente la he programado para que solo sea necesario seleccionar las celdas con los datos de origen y destino, sea un rango o celdas independientes y pulsar el botón de comando que existe en la hoja y se mostrará el mapa con la ruta.

Esta es la función:

Sub MAPA()
'Declaramos las variables
Dim Matriz As Object, Palabra As Variant, Area As Object
Dim alfaDato As Variant, iPalabra As String
'Creamos colección arraylist para ir agregando los elementos de la matriz
Set Matriz = CreateObject("System.Collections.ArrayList")
'Trabajamos con la hoja activa
With ActiveSheet
Set Area = Application.Intersect(Selection, .UsedRange)
'Controlamos que existan datos seleccionados
On Error GoTo Control
'Por cada objeto/palabra del rango seleccionado
For Each Palabra In Area
'Añadimos cada palabra a la matriz con un loop
Matriz.Add Palabra
Next Palabra
'Pasamos los datos a una cadena de texto
For Each alfaDato In Matriz
iPalabra = iPalabra & "/" & alfaDato
Next alfaDato
OrdenarAlfa = Trim(iPalabra)
'Abrimos explorador y mostramos la ruta
Url = "https://www.google.com/maps/dir" & OrdenarAlfa
ActiveWorkbook.FollowHyperlink Url, NewWindow:=False
'mostramos mensaje de error
Control: If Err.Number = "424" Then
MsgBox ("EL RANGO O LAS CELDAS SELECCIONADAS NO CONTIENEN DATOS"), vbExclamation, "SIN DATOS SELECCIONADOS"
End If
'Limpiamos variable de objeto
Set Matriz = Nothing
Set Area = Nothing
End With
End Sub

Y este es el resultado después de seleccionar y pulsar el botón:

ACTUALIZACION API MATRIZ DE DISTANCIAS1

Y con esto finalizamos el post de hoy, espero que este post os sea de utilidad.

Descarga el archivo de ejemplo pulsando en: ACTUALIZACIÓN API MATRIZ DE DISTANCIAS

IMPORTANTE:

Tal y como le comento a lectores anteriores, google ha dejado de ofrecer consultas al API libres,. ahora solicita una KEY para poder realizar las peticiones. No obstante, también comenta que los resultados sin API pueden ofrecer informaciones “degradadas”, o lo que es lo mismo, que en ocasiones no ofrezca resultado (mostrando el error que comentas).

En concreto, esto es lo que google ha comunicado:

A partir del 11 de junio de 2018, tendrás que habilitar la facturación con cargo a una tarjeta de crédito y contar con una clave de API válida para todos los proyectos. Esto te permitirá escalar el servicio fácilmente con períodos inactivos más cortos y menos problemas de rendimiento. Además, hemos reducido las 18 API individuales a solo tres productos: Maps, Routes y Places.

En junio de 2016 anunciamos que las solicitudes sin clave de API o ID de cliente dejarían de admitirse. Este cambio se hará efectivo el 11 de junio. A partir de esa fecha, no se podrá acceder sin clave y las llamadas sin clave a las API de Street View y JavaScript de Maps devolverán mapas de baja resolución con la marca de agua “for development purposes only.” (solo con fines de desarrollo). Las llamadas sin clave a cualquiera de las API siguientes devolverá un error: Maps Static API (incluida Static Street View), Directions API, Distance Matrix API, Geocoding API, Geolocation API, Places API, Roads API y Time Zone API.”

Aquí podréis leer sobre el tema: ENLACE NOTICIA

A pesar de ello, no voy a eliminar el post, dado que la programación puede ser interesante para otros proyectos o puede que deseéis modificarla para introducir la KEY (para lo que recomiendo que os pongáis en contacto con Google para proceder con total seguridad a introducir datos de tarjeta de crédito y habilitar la facturación).

 

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Anuncios