Função VBA - Busca Distância Entre Cidades

A função abaixo tem como objetivo buscar a distância entre duas cidades. No entrando, os comandos necessitam que a referência "Microsoft XML, v6.0" esteja ativada.


Habilite a referencia acima e cole o código abaixo em um módulo VBA.

Function Busca_Km(Origem As String, Destino As String) As Double
    'Requer referência ao: 'Microsoft XML, v6.0'

    Dim Solicitacao As XMLHTTP60
    Dim Doc As DOMDocument60
    Dim Distancia_Pontos As IXMLDOMNode

    Let Busca_Km = 0

    'Checa e limpa as entradas
    On Error GoTo Sair

    Let Origin = Replace(Origem, " ", "%20")
    Let Destination = Replace(Destino, " ", "%20")

    ' Le os dados XML da API do Google Maps.
    Set Solicitacao = New XMLHTTP60

    Solicitacao.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
        & Origin & "&destination=" & Destino & "&sensor=false", False
    Solicitacao.send

    ' Tornando o XML legível por usar o XPath
    Set Doc = New DOMDocument60

    Doc.LoadXML Solicitacao.responseText

    ' Obtendo o valor da distância entre os nós.
    Set Distancia_Pontos = Doc.SelectSingleNode("//leg/distance/value")
    If Not Distancia_Pontos Is Nothing Then Busca_Km = Distancia_Pontos.Text / 1000

Sair:
    ' Tidy up
    Set Distancia_Pontos = Nothing
    Set Doc = Nothing
    Set Solicitacao = Nothing
   
End Function

Comentários

  1. Bom dia,utilizei esta ferramenta mas ao fazer algumas correções, pois eram 303 calculos de distância, estava tudo certo e depois zerou todos os resultados não mais liberando a utilização. Tentei em outro dia, para saber questão de limites mas não liberou também, tem solução?

    ResponderExcluir

Postar um comentário

Postagens mais visitadas deste blog

Função VBA - Validador de CNPJ

Autocorreção no Excel - Eu Escrevo e o Excel Corrige.