[[20151127160724]] 『VBAにてGoogleMapsApiにて2点間の距離を取得した』(BB) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBAにてGoogleMapsApiにて2点間の距離を取得したい。(有料道路なしで)』(BB)

2点間の住所の緯度経度より有料道路を除く最短距離を取得したいのですが、
現状、有料道路が選択されており、困っています。

現状のコードです。

Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://maps.googleapis.com/maps/api/_
  distancematrix/xml?origins=" & 出発地点の緯度 & "," & _
  出発地点の経度 & "&destinations=" & 到着地点の緯度 &_
  "," & 到着地点の経度 & "", False
http.Send

よろしくお願いします。

< 使用 Excel:Excel2007、使用 OS:WindowsVista >


 avoidTolls=TRUE
 を加えたらどうだろうか?

 未確認のためうまくいかない場合はすまない。
(ねむねむ) 2015/11/27(金) 16:40

(ねむねむ)様

ご回答ありがとうございます。試しましたところ、うまくいかなかったです。
avoidTolls=TRUEは、どこに入れれば良いですか?
(BB) 2015/11/27(金) 17:00


 "," & 到着地点の経度 & "", False 
 を
 "," & 到着地点の経度 & "&avoidTolls=TRUE", False 
 でどうだろうか?

 もしこれでダメな場合は他の人の回答を待ってくれ。

(ねむねむ) 2015/11/27(金) 17:05


(ねむねむ)様
さっそくのご回答ありがとうございます。
そこに入れてみましたが、ダメでした。
もう少し、研究してみます。
(BB) 2015/11/27(金) 17:22

なんか飛び先の文字列結合のコーディングがめちゃめちゃなんですけど、そこが間違っているだけだった、とか?
ResponseTextからの抜き出しは手抜きな例。

 Sub test()
    Dim HTTP As Object
    Dim vw As Variant
    Dim i As Long
    Dim iw As Long

    Const 出発地点の緯度 As Double = 35.691235
    Const 出発地点の経度 As Double = 139.700174
    Const 到着地点の緯度 As Double = 35.762949
    Const 到着地点の経度 As Double = 139.730929

    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    HTTP.Open "GET", "https://maps.googleapis.com/maps/api/" & _
        "distancematrix/xml?origins=" & 出発地点の緯度 & "," & _
        出発地点の経度 & "&destinations=" & 到着地点の緯度 & _
        "," & 到着地点の経度, False
    HTTP.Send

    Do While HTTP.readyState <> 4
        DoEvents
    Loop

    vw = Split(HTTP.ResponseText, vbLf)
    For i = 0 To UBound(vw)
        If 0 < InStr(vw(i), "<distance>") Then
            iw = InStr(vw(i + 2), ">")
            MsgBox Mid(vw(i + 2), iw + 1, InStr(iw + 1, vw(i + 2), "<") - iw - 1)
            Exit For
        End If
    Next i

    Set HTTP = Nothing
 End Sub
(???) 2015/11/30(月) 14:05

(???)様
ご回答ありがとうございます。

ご回答いただいたコードだと高速道路を使用した距離が出てきます。
高速を使用しない距離をだしたいのですが、良い方法がありませんか?
よろしくお願いします。
(BB) 2015/12/01(火) 09:10


あとはavoidHighwaysやavoidTollsをTrueにしてみれば…、と思いましたが、パラメータが無視されるようですね。
JavaScript化しないと駄目かもです。そうなると、ささっと書くレベルでは無くなるので、
CreateObject("ADODB.Stream")でUTF-8ソースをWriteTextする方法なぞ検索してみてください。
(???) 2015/12/02(水) 10:36

(???)様
ご回答ありがとうございます。
やはり、無視されているのですね。

ありがとうございました。
別の方法を検討してみます。
(BB) 2015/12/02(水) 13:22


調べてみたら、ここの過去質問にたどり着いたという…。[[20150429195616]]

以下のように指定すると距離が変わりますが、これが高速なしの距離でしょうかね?

    HTTP.Open "GET", "https://maps.googleapis.com/maps/api/distancematrix/xml?" & _
        "origins=" & 出発地点の緯度 & "," & 出発地点の経度 & _
        "&destinations=" & 到着地点の緯度 & "," & 到着地点の経度 & "&avoid=highways", False
(???) 2015/12/03(木) 09:44

コーディングも書き直して、シンプルにしてみました。

 Sub test()
    Dim HTTP As Object

    Const 出発地点の緯度 As Double = 35.691235
    Const 出発地点の経度 As Double = 139.700174
    Const 到着地点の緯度 As Double = 35.103118
    Const 到着地点の経度 As Double = 136.955306

    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    HTTP.Open "GET", "https://maps.googleapis.com/maps/api/distancematrix/xml?" & _
        "origins=" & 出発地点の緯度 & "," & 出発地点の経度 & _
        "&destinations=" & 到着地点の緯度 & "," & 到着地点の経度 & "&avoid=highways", False
    HTTP.Send

    Do While HTTP.readyState <> 4
        DoEvents
    Loop

    MsgBox "時間:" & _
           HTTP.responseXML.DocumentElement.LastChild.LastChild.ChildNodes(1).LastChild.nodeTypedValue & vbLf & _
           "距離:" & _
           HTTP.responseXML.DocumentElement.LastChild.LastChild.ChildNodes(2).LastChild.nodeTypedValue

    Set HTTP = Nothing
 End Sub
(???) 2015/12/03(木) 10:35

(???)様

ありがとうございます。
出来ました。

感謝感謝です。

(BB) 2015/12/03(木) 13:57


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.