Discussion :

[Funbad]

Bonjour à toute la communauté,

J'avais jadis créé une macro pour calculer la distance entre 2 points A et B sur EXcel via Google.

Celle-ci ne fonctionne hélas plus (dans 80% des requêtes).

Ce qui est bizarre est qu'elle fonctionne toujours dans 20% des cas...

Quelqu'un saurait-il svp me dépanner ?

Merci mille fois à tous !


La voici...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub distanceCalculator()
 
    Dim fromWhere As String
    Dim toWhere As String
 
    lastLine = Range("A65536").End(xlUp).Row
 
    Range("C:C").Clear
 
    For i = 1 To lastLine
        fromWhere = Range("A" & i)
        toWhere = Range("B" & i)
        'distance = get_km(fromWhere, toWhere)
        distance = G_DISTANCE(fromWhere, toWhere)
        Range("C" & i) = distance
        Application.Wait (Now + TimeValue("0:00:01"))
    Next
End Sub
 
 
Function G_DISTANCE(Origin As String, Destination As String) As Double
' Requires a reference to Microsoft XML, v6.0
' Draws on the stackoverflow answer 
Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim distanceNode As IXMLDOMNode
    G_DISTANCE = 0
    ' Check and clean inputs
    On Error GoTo exitRoute
    'Origin = WorksheetFunction.EncodeURL(Origin)
    'Destination = WorksheetFunction.EncodeURL(Destination)
    Origin = Replace(Origin, "", "% 20")
    Destination = Replace(Destination, "", "% 20")
 
    ' Read the XML data from the Google Maps API
    Set myRequest = New XMLHTTP60
    myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
        & Origin & "&destination=" & Destination & "&sensor=false", False
    myRequest.send
    ' Make the XML readable usign XPath
    Set myDomDoc = New DOMDocument60
    myDomDoc.LoadXML myRequest.responseText
    ' Get the distance node value
    Set distanceNode = myDomDoc.SelectSingleNode("//leg/distance/value")
    If Not distanceNode Is Nothing Then G_DISTANCE = CDbl(distanceNode.Text) / 1000
exitRoute:
    ' Tidy up
    Set distanceNode = Nothing
    Set myDomDoc = Nothing
    Set myRequest = Nothing
End Function
 
 
Function get_km(place_a, place_b)
 my_xml_path = "http://maps.google.fr/maps?saddr=" & place_a & "&daddr=" & place_b & "&ie=utf-8&v=2.1&cv=4.0.2744&hl=fr&output=kml"
 Set xmlDoc = CreateObject("MSXML2.DOMDocument")
 xmlDoc.async = False
 xmlDoc.Load (my_xml_path)
 Set nodelist = xmlDoc.getElementsByTagName("description")
 my_raw_string = nodelist.Item(nodelist.Length - 1).FirstChild.NodeValue
 get_km = Monextract(my_raw_string, ": ", "&")
End Function
 
Function Monextract(machaine, debut, fin)
 PosH1 = InStr(1, machaine, debut)
 PosH2 = InStr(1, machaine, fin)
 long_first = Len(debut)
 Leng = PosH2 - PosH1 - long_first
 Monextract = Mid(machaine, PosH1 + long_first, Leng)
 End Function

[Menhir]

Commence par supprimer ton On Error.
Ensuite tu exécute ton code en pas-à-pas en observant la valeur des variables dans la fenêtre des variables locales pour vérifier à quel moment leur contenu n'est plus conforme à ce qu'il devrait être.

[patricktoulon]

visiblement ma vielle fonction fonctionne toujours

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub test()
    distancier_google "avenue general brosset  83200 toulon", "avenue vauban 83000 toulon"
End Sub
Function distancier_google(start, dest)
'creation d'un object xmldoc en memoire
    Set xmldoc = CreateObject("Microsoft.XMLDOM")
    xmldoc.Async = "false"
    'creation de l'url avec les arguments
    URL = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & start & "&destinations=" & dest & "&language=fr-FR"
    xmldoc.Load (URL)    'load de l'url dans le xmldoc
    'Debug.Print xmldoc.XML
    'examen du fichier en DOM
    For Each Distances In xmldoc.SelectNodes("/DistanceMatrixResponse")
        Status = Distances.SelectSingleNode("status").Text
        If Status = "OK" Then
            depart = Distances.SelectSingleNode("origin_address").Text
            Debug.Print depart
            Arrivee = Distances.SelectSingleNode("destination_address").Text
            Debug.Print Arrivee
            For Each Row In xmldoc.SelectNodes("/DistanceMatrixResponse/row/element")
                Status = Row.SelectSingleNode("status").Text
                If Status = "OK" Then
                    'on imbrique 2 boucles "la distance" et le "temps"
                    For Each Distance In xmldoc.SelectNodes("/DistanceMatrixResponse/row/element/distance")
                        En_M = Distance.SelectSingleNode("value").Text
                        Debug.Print En_M & " metres"
                        En_KM = Distance.SelectSingleNode("text").Text
                        Debug.Print En_KM & " kilomètres"
                        For Each Duration In xmldoc.SelectNodes("/DistanceMatrixResponse/row/element/duration")
                            En_SS = Duration.SelectSingleNode("value").Text
                            Debug.Print En_SS; " secondes"
                            En_MM = Duration.SelectSingleNode("text").Text
                            Debug.Print En_MM
                        Next
 
                    Next
                Else
                End If
            Next
        Else
        End If
    Next
        Set xmldoc = Nothing
 
End Function

attenttion a la precision du depart et d'arrivée si ca n'est pas precis google te renvoie plusieur possibilités il faut donc fouiller le xml

[Jean-Philippe André]

visiblement ma vielle fonction fonctionne toujours

Tu parles du code de cette discussion ?

https://www.developpez.net/forums/d1.../#post10013244

[Pierre Fauconnier]

Je rappelle qu'il nest pas nécessairement de supprimer les On Error. Il suffit de modifier temporairement les options liées au comportement sur erreurs, ce qui est tout de même plus pratique

[patricktoulon]

Tu parles du code de cette discussion ?

https://www.developpez.net/forums/d1.../#post10013244

non celle ci vient de mes archives persos cela dit c'est la meme chose

particularité de cette version:
je ne fait pas de requete avec un des object request
je load l'url directement dans le xml
l'url de cette facon permet d'etre moins precis quitte a fouiller le xml pour trouver les proposition plus precises ca peut etre interessant quand on a pas le numero de rue etc...
reste la limite du nombre de demande sans licences j'ai pas testé j'ai jamais depassé les 50 demandes

.

[Menhir]

ce qui est tout de même plus pratique

Je suis d'accord avec toi, c'est plus pratique pour quelqu'un qui a une connaissance raisonnable du VBE.
Cependant "supprimer" est plus simple à expliquer à un débutant. Ne connaissant pas le niveau de l'interlocuteur, je préfère aller au plus simple.