Google Maps API を使って2点間の距離を求めるユーザー定義関数を作る

上の図のC列には出発地、D列には目的地、E列には下の式が入っています。

=DGMAP ([origin], [destination], TRUE: distance/ FALSE: time)

このユーザー定義関数は距離と時間の両方を返すことができますが、第３引数にTRUEを入れると距離が、FALSEを入れると時間を返すように変更しています。この関数で利用しているGoogle Maps APIがいつまで利用可能か分かりませんが、2018年1月19日現在、問題なく利用できています。

コードのほとんどは、ここ から拝借しました。 Microsoft XML v.[version]を参照設定して、次のコードを標準モジュール内に貼り付けて下さい。

（修正 2019/10/22）

Google Direction APIは、残念ながらAPIキーなしでの利用ができなくなっているようです。 APIキーを取得して、コードに追加して下さい。

"sXMLURL = ..." でhttpを https に変更。APIキーを追加）

Function DGMAP(origin As String, destination As String, distance As Boolean) As String 'http://stackoverflow.com/questions/10116301/google-maps-api-for-time-and-distance-data-access-vba Dim sXMLURL As String sXMLURL = "https://maps.googleapis.com/maps/api/directions/xml?origin=" & origin & "&destination=" & destination & "&sensor=false&key=APIキー" Dim objXMLHTTP As MSXML2.ServerXMLHTTP60 Set objXMLHTTP = New MSXML2.ServerXMLHTTP60 With objXMLHTTP .Open "GET", sXMLURL, False .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded" .Send End With 'Debug.Print objXMLHTTP.ResponseText Dim domResponse As DOMDocument60 Set domResponse = New DOMDocument60 domResponse.LoadXML objXMLHTTP.ResponseText Dim ixnStatus Set ixnStatus = domResponse.SelectSingleNode("//status") If ixnStatus.Text = "OK" Then Dim ixnDistance, ixnDuration Set ixnDistance = domResponse.SelectSingleNode("/DirectionsResponse/route/leg/distance/text") Set ixnDuration = domResponse.SelectSingleNode("/DirectionsResponse/route/leg/duration/text") End If If IsEmpty(ixnDistance) Then DGMAP = "Empty" Exit Function End If

　'距離（True) または時間（False) If distance = True Then DGMAP = left(ixnDistance.Text, InStr(1, ixnDistance.Text, " ") - 1) Else DGMAP = ixnDuration.Text End If Set domResponse = Nothing Set objXMLHTTP = Nothing End Function