[Resolvido]GMaps x Custo de Locomoção

Pessoal...

preciso implementar uma função aqui, utilizando api do gmaps distancematrix, eu busco distância entre 2 endereços ou 2 ceps ou 2 municípios, digitando:

Código:

https://maps.googleapis.com/maps/api/distancematrix/json?destinations=11410-001&origins=11432-320&units=metric&key="MinhaKey"

(já tenho "MinhaKey" do google cloud)

retornando em json:

Código:

{
  "destination_addresses" : [ "Centro, Guarujá - SP, 11410-001, Brasil" ],
  "origin_addresses" : [
      "R. das Magnólias - Jardim Primavera, Guarujá - SP, 11432-320, Brasil"
   ],
  "rows" : [
     {
        "elements" : [
            {
               "distance" : {
                  "text" : "2,3 km",
                  "value" : 2341
               },
               "duration" : {
                  "text" : "8 minutos",
                  "value" : 477
               },
               "status" : "OK"
            }
         ]
     }
  ],
  "status" : "OK"
}

agora preciso tirar "distance":"text":"2,3 km" e "duration":"text":"8 minutos"

para 2 caixas de texto do meu form...

alguém pode me ajudar?

Olá Nilton Vassão,

Não são permitidos links externos, já retifiquei colocando como código.

Quanto à questão se o resultado for sempre na mesma linha, pode ser fácil capturar via line input.
Caso não seja, veja se tópicos abaixo ajuda:
https://www.maximoaccess.com/t33067-resolvidoler-ficheiro-json-pelo-vba
https://www.maximoaccess.com/t20159p3-resolvidoimportando-nota-fiscal-eletronica-xml-para-access (Mensagem nr 22 função SeparaEntreDuasStrings)
https://www.maximoaccess.com/t26893-resolvidoextrair-texto-copiado-de-pagina-da-internet-e-inserir-valores-em-novos-registros

Também existe esta solução, creio ser a mais acertada, mas nunca usei nem testei
github.com/VBA-tools/VBA-JSON

Abraço

Olá Teixeira

Se vc tiver outra opção para ler xml serve também, desde que eu informe a url pelo meu form e tenha o retorno em 2 caixas de texto  de "distance" e "duration" no mesmo form.

Segue o retorno em xml da minha requisição...

Código:

<?xml version="1.0" encoding="UTF-8"?>
<DistanceMatrixResponse>
 <status>OK</status>
 <origin_address>R. das Magnólias - Jardim Primavera, Guarujá - SP, 11432-320, Brasil</origin_address>
 <destination_address>Centro, Guarujá - SP, 11410-001, Brasil</destination_address>
 <row>
  <element>
   <status>OK</status>
   <duration>
    <value>477</value>
    <text>8 minutos</text>
   </duration>
   <distance>
    <value>2341</value>
    <text>2,3 km</text>
   </distance>
  </element>
 </row>
</DistanceMatrixResponse>


grato pela atenção!

Olá Nilton Vassão,

Já tem o método para a chamada?
Se não tem, veja este tópico na mensagem nr. 5
https://www.maximoaccess.com/t33653-capturar-obter-data-e-hora-de-website

Se tiver dificuldades em criar, para o ajudar, envie por mensagem privada:
a) APIKEY
b) 3 exemplos de URLs para chamada (1 deles pode ser com erro)

Abraço

Segue form iniciado...

Olá Nilton Vassão,

Obrigado pelo envio, estou a trabalhar nisso.~



Abraço

Olá Nilton Vassão,

Com recurso a exemplos do fórum, está feito:


Veja o código utilizado:

Código:

Option Compare Database
Option Explicit

Private Sub cmdCalcular_Click()
'Alvaro Teixeira (ahteixeira) 2022 para MaximoAccess
'Requer função: fncAPIdistancematrix
'Requer função: separaEntreDuasStringsXML
'Requer função: DLTiraAcentos
'Requer função: DLTiraAcentos_GetCorrectChar

Dim xData, xReturn, xPos

    xData = fncAPIdistancematrix() 'fazer leitura url
                
    xReturn = separaEntreDuasStringsXML(xData, "<status>", "</status>") 'verifica se deu erro
    If xReturn = "INVALID_REQUEST" Then MsgBox "Erro na leitura: INVALID_REQUEST", vbCritical, "": Exit Sub
    
    xPos = InStr(xData, "<duration>") 'obter duracao
    xData = Right(xData, Len(xData) - xPos)
    Me.txtDuration = separaEntreDuasStringsXML(xData, "<text>", "</text>")

    xPos = InStr(xData, "<distance>") 'obter distancia
    xData = Right(xData, Len(xData) - xPos)
    Me.txtDistance = separaEntreDuasStringsXML(xData, "<text>", "</text>")

End Sub

Function separaEntreDuasStringsXML(strTotal, strInicio As String, strFim As String)
'2014 Alvaro Teixeira
Dim i As Long, j As Long
    i = InStr(strTotal, strInicio)
    j = InStr(strTotal, strFim)
    separaEntreDuasStringsXML = Mid(strTotal, i + Len(strInicio), j - i - Len(strInicio))
End Function


Function fncAPIdistancematrix() As String
'ahteixeira 2022 para MaximoAccess
'requer a referencia Microsoft XML 6.0

    Dim xmlhttp As XMLHTTP60
    Dim sUrl, sResposta As String

    Set xmlhttp = New XMLHTTP60
    sUrl = "https://maps.googleapis.com/maps/api/distancematrix/xml?destinations=" & Chr(34) & DLTiraAcentos(Me.txtDestin) & Chr(34) & "&origins=" & Chr(34) & DLTiraAcentos(Me.txtOrigin) & Chr(34) & "&units=metric&key=" & Me.txtAPIKey

    xmlhttp.Open "GET", sUrl, False
    xmlhttp.send

    sResposta = Trim(xmlhttp.responseText)
    fncAPIdistancematrix = sResposta
End Function

Public Function DLTiraAcentos(ByVal strOriginal As String)
'By JPaulo @ 2009
    Dim strToReturn As String
    strToReturn = ""
    
    Dim i As Integer
    For i = 1 To Len(strOriginal)
        strToReturn = strToReturn & DLTiraAcentos_GetCorrectChar(Mid$(strOriginal, i, 1))
    Next i
    
    DLTiraAcentos = strToReturn
End Function

Public Function DLTiraAcentos_GetCorrectChar(ByVal strChar As String) As String
    Dim LetrasComAcentos As String
    Dim LetrasSemAcentos As String
    LetrasComAcentos = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊáíóúéäïöüëàìòùèãõâîôûêÇç"
    LetrasSemAcentos = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"
    Dim i As Integer
    For i = 1 To Len(LetrasComAcentos)
        If strChar = Mid$(LetrasComAcentos, i, 1) Then
            DLTiraAcentos_GetCorrectChar = Mid$(LetrasSemAcentos, i, 1)
            Exit Function
        End If
    Next
    
    DLTiraAcentos_GetCorrectChar = strChar
End Function




Deixo o exemplo para quem precisar.
NOTA: É necessária a chave da API para funcionar.

Abraço

Olá Teixeira...

Muito bom, perfeito, maravilha...

funciona perfeitamente!

És gênio!!!

Muito obrigado

Olá Nilton Vassão,

Obrigado pelo retorno, o fórum agradece.

Não se esqueça de dar o tópico como Resolvido, veja como fazer:
https://www.maximoaccess.com/t860-resolucao-de-topicos

Abraço

Para quem precisar da API KEY...

Só entrar no Google Cloud, com uma conta de gmail vc ativa uma API conforme sua necessidade, No caso deste exemplo a API é "distance matrix". Existem vários tipos de API para várias aplicações.

O Google disponibiliza um crédito inicial, para vc ir utilizando a API, se exceder uma quota mensal que no meu caso são 2000 request você vai pagar na fatura do cartão de crédito uma mensalidade que no meu caso são 54,00 reais. Como não devo utilizar todos os request disponíveis devo ficar usando a API gratuitamente.

Na ativação da API será solicitado o número do seu cartão de crédito.

Para cada tipo de API/Request haverá um valor diferente a pagar.

Algumas são gratuitas.

Olá Nilton Vassão,

Obrigado pela informação complementar, muito útil para quem pretende obter as chaves
O fórum agradece.

Abraço