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
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
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