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