Lecture des données de Google Maps

Version imprimable

Bonsoir,

J'ai réalisé une connexion avec google maps pour lire la distance et la durée avec le code suivant :

Code:

ConnectStr = "URL;https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & PointDépart & "&destinations=" & PointArrivée & "&sensor=false"

Les informations s'affichent bien sur la feuille demandée dans la première colonne comme indiquée ci-dessous.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
{
   "destination_addresses" : [ "Saint-Trivier-sur-Moignans, France" ],
   "origin_addresses" : [ "Allonzier-la-Caille, France" ],
   "rows" : [
      {
         "elements" : [
            {
               "distance" : {
                  "text" : "143 km",
                  "value" : 143398
               },
               "duration" : {
                  "text" : "1 hour 40 mins",
                  "value" : 6009
               },
               "status" : "OK"
            }
         ]
      }
   ],
   "status" : "OK"
}

Pour récupérer la distance et la durée, j'ai écris cela :

Code:

1
2
3
4
5
6
7
8
 .Refresh BackgroundQuery:=False
        NEssai = NEssai + 1
    Set Result = Sheets("Calcul").Range("A1:B100").Find("duration")
        If Not Result Is Nothing Then
        Adresse = Result.Address
        Set Plage = Sheets("Calcul").Range(Adresse & ":A100")
        NEssai = 6 'On sort de la boucle quand on a un résultat
        End If

Le problème est que le programme ne détecte pas "duration" et de même quand je fais sur la feuille directement un CTRL + F
Avez vous une idée ?

Cordialement,

25/02/2015, 20h15
mercatog

Code:

.....Find("duration", LookIn:=xlValues, LookAt:=xlPart)
25/02/2015, 22h29
grimgrim

Merci je vais tester

Par contre, peux tu expliquer à quoi correspond ces deux attributs, je n'ai pas trouver

Cordialement,

heu

bonjour
je te propose un autre regard en utilisant un object xmlhttp en VBA

dans la fonction tu a 2 variables qui sont des string et qui contienne les valeur que tu cherche a toi d'adpater

il te suffit d'injecter le depart et l'arrivée dans l'appel de la fonction dans la sub test

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'exemple https://maps.googleapis.com/maps/api/distancematrix/json?origins=toulon&destinations=paris&sensor=false"
Sub test()
    donnéegooglemaps "toulon", "paris"
End Sub
Function donnéegooglemaps(depart, arrivée)
    Dim DemandeFichier As Object, distance As String, durrée As String,url as string 
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & depart & "&destinations=" & arrivée & "&sensor=false"
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
    DemandeFichier.Open "POST", url, False
    DemandeFichier.send
    'MsgBox DemandeFichier.responsetext'ce message t'affiche tout le texte en entier
 
    distance = Split(Split(DemandeFichier.responsetext, "text"" : ")(1), ",")(0)
    durrée = Split(Split(DemandeFichier.responsetext, "text"" : ")(2), ",")(0)
 
 
 MsgBox "disitance a parcourir = " & distance & vbCrLf & "durée du voyage = " & durrée
End Function

a mediter

26/02/2015, 09h48
grimgrim

Merci, cela fonctionne

la solution de PatrickToulon fonctionne, l'autre solution émet une erreur

Par contre, Patrick, j'obtiens une erreur quand il ne trouve pas d'information NOT_FOUND

et cela bloque

Cordialement,

Bonjour
c'est un code de base que je t'ai donné

il va te falloir maintenant intégrer la gestion d'erreur

pour cela il faut que tu VERIFIE la présence de "NOT-FOUND" dans le texte retourné du json

la fonction INSTR fera très bien l'affaire

simplement comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
'exemple https://maps.googleapis.com/maps/api/distancematrix/json?origins=toulon&destinations=paris&sensor=false"
Sub test()
    donnéegooglemaps "trucmuche", "paris"
End Sub
Function donnéegooglemaps(depart, arrivée)
    Dim DemandeFichier As Object, distance As String, durrée As String, url As String, message As String
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & depart & "&destinations=" & arrivée & "&sensor=false"
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
    DemandeFichier.Open "POST", url, False
    DemandeFichier.send
   ' MsgBox DemandeFichier.responsetext    'ce message t'affiche tout le texte en entier
 
    If InStr(DemandeFichier.responsetext, "NOT_FOUND") > 0 Then
        message = "pas de donnée pour ce parcour " & vbCrLf & " veuillez verifier le depart ou destination"
    Else
        distance = Split(Split(DemandeFichier.responsetext, "text"" : ")(1), ",")(0)
        durrée = Split(Split(DemandeFichier.responsetext, "text"" : ")(2), ",")(0)
        message = "disitance a parcourir = " & distance & vbCrLf & "durée du voyage = " & durrée
    End If
    MsgBox message
End Function

rien de plus facile ;)
Au plaisir

Bonjour
j'ai revu plus précisément la gestion d'erreur

maintenant tu a trois résultat possible
1 si le parcourt n'est pas trouvé tu a le message qui te le dit ( NOT_FOUND)

2 si il y a des accents ou autre symbole dans l'adresse de départ ou de destination il est possible que la requête plante le message t'en averti (INVALID_REQUEST)

3 si la requete passe elle te donne le kilométrage et la duré

j'ai aussi ajouté un argument a la fonction "format_time" a préciser dans l'appel a la fonction dans la sub test en 3 eme position

si c'est true tu aura la durée en format time ( 08:50:00)

si c'est false
tu l'aura sous ce format (08 hours 50 mins)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub test()
    donnéegooglemaps "toulon", "parois", False
End Sub
Function donnéegooglemaps(depart, arrivée, format_time)
    Dim DemandeFichier As Object, distance As String, durrée As String, url As String, message As String
    url = "<a href="https://maps.googleapis.com/maps/api/distancematrix/json?origins" target="_blank">https://maps.googleapis.com/maps/api...x/json?origins</a>=" & depart & "&destinations=" & arrivée & "&sensor=false"
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
    DemandeFichier.Open "POST", url, False
    DemandeFichier.send
    MsgBox DemandeFichier.responsetext    'ce message t'affiche tout le texte en entier
    If InStr(DemandeFichier.responsetext, "NOT_FOUND") > 0 Then
        message = " il n'y a pas de données pour ce parcour"
 
    ElseIf InStr(DemandeFichier.responsetext, "INVALID_REQUEST") > 0 Then
    message = " la requette n'a pas abouti " & vbCrLf & " verifiez les accents et autre symboles dans le depart ou destination " & vbCrLf & "supprimez les le cas echeant"
 
    ElseIf InStr(DemandeFichier.responsetext, "text") > 0 Then
        distance = Split(Split(DemandeFichier.responsetext, "text"" : """)(1), """,")(0)
        durrée = Split(Split(DemandeFichier.responsetext, "text"" : """)(2), """,")(0)
        If format_time Then
            durrée = Replace(Replace(Replace(durrée, "hours", ":"), "mins", ":00"), "  ", "")
            durrée = format(Split(durrée, ":")(0), "00") & ":" & Split(durrée, ":")(1) & ":00"
        End If
        message = "disitance a parcourir = " & distance & vbCrLf & "durée du voyage = " & format(durrée, "hh:mm:ss")
    End If
    MsgBox message
End Function