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