Gmaps

Como adicionar uma API do Google para retornar a distância ou tempo de uma rota definida.

Com esta consulta é possível retornar a distância e o tempo médio da rota, baseado na mesma engine do Google Maps.

O resultado pode ser retornado por Carro, caminhada, bicicleta (quando Disponível) ou transporte publico (quando disponível)

O resultado Fica assim:

Agora, como montamos esse arquivo?

Mãos a massa:

1. Precisamos retirar os acentos dos nomes, pois a API não reconhece acentos, para isso vamos criar uma Function que retira os acentos:

Function Acento(caract)
'Acentos e caracteres especiais que serão buscados na string
'Você pode definir outros caracteres nessa variável,
'mas precisará também coloca-los sem acento!
codiA = "àáâãäèéêëìíîïòóôõöùúûüÀÁÂÃÄÈÉÊËÌÍÎÒÓÔÕÖÙÚÛÜçÇñÑ"
'Letras correspondentes para substituiçãor a letra correspondente em codiB
codiB = "aaaaaeeeeiiiiooooouuuuAAAAAEEEEIIIOOOOOUUUUcCnN"
'Armazena em temp a string recebida
temp = caract
'Loop que irá de andará a string letra a letra
For i = 1 To Len(temp)
'InStr buscará se a letra indice i de temp pertence a
' codiA e se existir retornará a posição dela
p = InStr(codiA, Mid(temp, i, 1))
'Substitui a letra de indice i em codiA pela sua
' correspondente em codiB
If p > 0 Then Mid(temp, i, 1) = Mid(codiB, p, 1)
Next
'Retorna a nova string
Acento = temp
End Function

com essa function podemos chamar ela quando necessário na proxima function:

2. Vamos a API propriamente dita:

Antes de começarmos, você deve adicionar a referência Microsoft XML, v6.0

Function DST(Resultado As String, Modo As String, Origem As String, Destino As String) As Variant
    ' Requer referencias Microsoft XML, v6.0
    Dim MyReq As XMLHTTP60
    Dim MyDoc As DOMDocument60
    Dim MyDist As IXMLDOMNode
    
    Let DST = 0
        'converte para texto especial
        Select Case UCase(Resultado)
        Case "KM"
        a = "distance/value"
        Case "H"
        a = "duration/text"
        Case "ORIGEM"
        a = "start_address"
        Case "DESTINO"
        a = "end_address"
        End Select
        
        
        Select Case UCase(Modo)
        Case "CARRO"
        b = "driving"
        Case "CAMINHADA"
        b = "walking"
        Case "BIKE"
        b = "bicycling"
        Case "PUBLICO"
        b = "transit"
        End Select
   
    On Error GoTo exitRoute
    
    Let Origem = Replace(Acento(Origem), " ", "%20")
    Let Destino = Replace(Acento(Destino), " ", "%20")
    
    ' Lendo os dados XML da API do Google Maps.
    Set MyReq = New XMLHTTP60
    
    MyReq.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
        & Origem & "&destination=" & Destino & "&sensor=false&mode=" & b, False
    MyReq.send
    
    ' Tornando o XML legível por usar o XPath
    Set MyDoc = New DOMDocument60
    
    MyDoc.LoadXML MyReq.responseText
    
    ' Obtendo o valor da distância entre os nós.
    Set MyDist = MyDoc.SelectSingleNode("//leg/" & a)
    
    If UCase(Resultado) <> "KM" Then
    If Not MyDist Is Nothing Then DST = MyDist.Text
    Else
    If Not MyDist Is Nothing Then DST = MyDist.Text / 1000
    
    End If
exitRoute:
    ' zerar strings
    Set MyDist = Nothing
    Set MyDoc = Nothing
    Set MyReq = Nothing
    
End Function

pronto! sua API está criada!

Lembre-se!

Essa API permite somente 2500 consultas por dia!!!

Adicionalmente você pode colocar as descrições nas formulas:

como?

assim:

Sub DescribeFunction()
'adiciona texto a função
   Dim FuncName As String
   Dim FuncDesc As String
   Dim Category As String
   Dim ArgDesc(1 To 4) As String
   FuncName = "DST"
   FuncDesc = "Retorna dados de rotas via Google API"
   Category = 5 'Lookup
   ArgDesc(1) = "Tipo da rota"
   ArgDesc(2) = "Origem"
   ArgDesc(3) = "Destino"
   ArgDesc(4) = "Tipo de resultado"
   Application.MacroOptions _
      Macro:=FuncName, _
      Description:=FuncDesc, _
      Category:=Category, _
      ArgumentDescriptions:=ArgDesc
      
      
End Sub