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
| Option Compare Database
Function G_DISTANCE(Origin As String, Destination As String) As Double
' Nécessite lé référence MsXML 6.0
Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim distanceNode As IXMLDOMNode
G_DISTANCE = 0
' Check and clean inputs
On Error GoTo exitRoute
Origin = URLEncode(Origin)
Destination = URLEncode(Destination)
'
Set myRequest = New XMLHTTP60
myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
& Origin & "&destination=" & Destination & "&sensor=false", False
myRequest.send
' Utilisation de xpath
Set myDomDoc = New DOMDocument60
myDomDoc.loadXML myRequest.responseText
'
' récupère la valeur dans le noeud
'
Set distanceNode = myDomDoc.selectSingleNode("//leg/distance/value")
If Not distanceNode Is Nothing Then G_DISTANCE = distanceNode.Text / 1000
exitRoute:
' fermeture et libération des objets
Set distanceNode = Nothing
Set myDomDoc = Nothing
Set myRequest = Nothing
End Function
Function URLEncode(strData)
Dim I, strTemp, strChar, strOut, intAsc
strTemp = Trim(strData)
For I = 1 To Len(strTemp)
strChar = Mid(strTemp, I, 1)
intAsc = Asc(strChar)
If (intAsc >= 48 And intAsc <= 57) Or (intAsc >= 97 And intAsc <= 122) Or (intAsc >= 65 And intAsc <= 90) Then
strOut = strOut & strChar
Else
strOut = strOut & "%" & Hex(intAsc)
End If
Next
URLEncode = strOut
End Function |
Partager