[Resolvido]Distâncias entre Cidades

Olá amigos tudo bem ?

Procuro um código que me dê a distancia entre duas cidades, seria possível ?

Precisava  de algo assim

Cidade Origem:
Cidade Destino:
Distancia KM:



Desde já agradeço muito

Alguem ?

Experimente este site é gratuito.
Ex.:
http://www.distance2villes.com/recherche?source=sao%20paulo&destination=rio%20de%20janeiro

Código:



Sub Distance()
    
    Const DIST1 As String = "http://www.distance2villes.com/recherche?source="
    Const DIST2 As String = "&destination="
    Const DIST3 As String = "distanciaRuta"
    Const wsName As String = "Feuil1"
    
    'Dim w As Object: Set w = CreateObject("WINHTTP.WinHTTPRequest.5.1")
    Dim w As Object: Set w = CreateObject("MSXML2.XMLHTTP")
    Dim h As Object: Set h = CreateObject("htmlfile")
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(wsName)
    Dim rg As Range
    Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(, 1))
    Dim Data As Variant: Data = rg.Value
    
    Dim isFound As Boolean: isFound = True
    Dim i As Long
    Dim Url As String
    Dim S As String
    
    For i = 1 To UBound(Data, 1)
        If Len(Data(i, 1)) > 0 And Len(Data(i, 2)) > 0 Then
            Url = DIST1 & Data(i, 1) & DIST2 & Data(i, 2)
            w.Open "GET", Url, False
            w.Send
            h.body.innerHTML = w.responseText
            On Error GoTo NotFoundError
            S = h.getElementById(DIST3).innerText
            On Error GoTo 0
            If isFound Then
                Data(i, 1) = Replace(Left(S, Len(S) - 3), ",", "")
            Else
                Data(i, 1) = ""
                isFound = True
            End If
        Else
            Data(i, 1) = ""
        End If
    Next
    rg.Columns(1).Offset(, 2).Value = Data
    
    Exit Sub

NotFoundError:
    isFound = False
    Resume Next

End Sub




fonte: https://stackoverflow.com/questions/66870615/how-to-calculate-the-distance-between-two-cities-by-specifying-the-country-in-vb

Opa valeu, muito obrigado


Vou tentar adaptar aqui

Com a ajuda do MUCA COSTA

dou o assunto como resolvido

Obrigado MUCa