[[20220118205238]]　『『Googleマップで車で行く距離と時間を抽出する方』（ひこ）　ページの最後に飛ぶ

『『Googleマップで車で行く距離と時間を抽出する方法』』（ひこ）

VBA初心者です。IEにてGoogleマップから車での最短ルートの移動時間を取得したいと考えています。
M列（M2,M3,・・・）にURLがあるので、そこを開いて移動時間を取得してL列（L2、L3、・・・）に移動時間を抽出するというVBAを組みたいのですが、URLを開くところと、車ボタンをクリックするところまではできましたが、移動時間の抽出がうまくいきません。
恐れ入りますが、どなたかご教授お願い致します。

●M列(M2,M3,・・・)には、以下のURLを入れています。
　"https://www.google.co.jp/maps/dir/"住所1"/"住所2"
●セルB1に住所1（固定）があります。
●C列（C2,C3,・・・）に住所2があります。
●会社パソコンがドライバーなどのインストールが実施できないためIEにての　方法をご教授お願い致します。

===以下、現在のコード=====
Sub test()

        Dim IE As Object
        Dim Document As String
        Dim gyou As Integer     '行の番号
        Dim span As HTMLSpanElement

　　　　'2行目～記載されている行まで見ていく

        For gyou = 2 To Cells(Rows.Count, "C").End(xlUp).Row

            Set IE = CreateObject("InternetExplorer.Application")
            IE.Navigate Cells(gyou, "M")
            IE.Visible = True 'IE画面を開く

            While IE.Busy Or IE.readyState <> 4 
                Sleep 3000
                DoEvents
            Wend

            DoEvents
            IE.Document.getElementsByClassName("Wnt0je-urwkYd-WAutxc-　　　icon")(1).Click  '車ボタンをクリック
            Sleep 2000

            For Each span In IE.Document.getElementsByClassName("xB1mrd-T3iPGc-iSfDt-duration delay-light gm2-subtitle-alt-1")
                If InStr(span.innerText, "分") > 0 Then
                    Cells(gyou, "L") = span.innerText
                End If
            Next
            IE.Quit  'IEのウィンドウを閉じる
            Set IE = Nothing  '生成したIEオブジェクトを破棄
        Next

        MsgBox "全ビルの移動時間の集計が終わりました。"
End Sub

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

タイトルを間違えました。取得したいのは、移動時間のみです。失礼いたしました。
（ひこ） 2022/01/18(火) 20:58

 IEの取扱い順序を変えただけですけど、普通に結果が出ましたけども。
 実行タイミングで結果が違っちゃうのでしょうかね？

 Sub test()
     Dim IE As Object
     Dim Document As String
     Dim gyou As Integer     '行の番号
     Dim span As HTMLSpanElement

     Set IE = CreateObject("InternetExplorer.Application")
     IE.Visible = True 'IE画面を開く

     '2行目～記載されている行まで見ていく
     For gyou = 2 To Cells(Rows.Count, "C").End(xlUp).Row
         IE.Navigate Cells(gyou, "M")

         While IE.Busy Or IE.readyState <> 4
             Sleep 3000
             DoEvents
         Wend

         DoEvents

         IE.Document.getElementsByClassName("Wnt0je-urwkYd-WAutxc-icon")(1).Click  '車ボタンをクリック
         Sleep 2000

         For Each span In IE.Document.getElementsByClassName("xB1mrd-T3iPGc-iSfDt-duration delay-light gm2-subtitle-alt-1")
             If InStr(span.innerText, "分") > 0 Then
                 Cells(gyou, "L") = span.innerText
             End If
         Next
     Next

     IE.Quit  'IEのウィンドウを閉じる
     Set IE = Nothing  '生成したIEオブジェクトを破棄

     MsgBox "全ビルの移動時間の集計が終わりました。"
 End Sub

（半平太） 2022/01/19(水) 00:12

半平太様
ご回答ありがとうございます。
時間は取得できるのですが最速ルートにならない時があるのと、『●●分通常』と、通常という文字まで抜き出してしまいます。何か改善方法はないでしょうか、、、

（ひこ） 2022/01/19(水) 08:17

  ＞時間は取得できるのですが最速ルートにならない時があるのと、
  最速って、一番目に取れるものじゃないですかね？
  そうだとすれば、直ぐループから抜ければいいでしょう。

  ＞『●●分 通常』と、通常という文字まで抜き出してしまいます。何か改善方法はないでしょうか、、、
  「分」までで切り捨てる。

  ＞  Dim span As HTMLSpanElement
      Dim Pos As Long　　　　　　　　’←追加

  ＞             If InStr(span.innerText, "分") > 0 Then
  ＞                 Cells(gyou, "L") = span.innerText
  ＞             End If

         変更　↓

              Pos = InStr(span.innerText, "分")
              If Pos > 0 Then
                  Cells(gyou, "L") = Left(span.innerText, Pos)　’「分」までを書き出す
                  Exit For　　’ループから抜ける
              End If

（半平太） 2022/01/19(水) 09:31

 URLに車移動の条件設定を入れることができます。
 そうすることで車をクリックする時間が省略できます。

 半平太さんのコードも参照させていただいて私なりに作ってみました。
 私のコードでは内部でURLを生成するのでM列は使用しません。

 Sub test()
     Dim IE         As Object
     Dim Document   As String
     Dim gyou       As Integer     '行の番号
     Dim span       As HTMLSpanElement
     Dim Pos        As Long

     '基準となるURL（車移動を設定）
     Const MapURL = "https://www.google.co.jp/maps/dir/?saddr=<<<&daddr=>>>&dirflg=d"

     Set IE = CreateObject("InternetExplorer.Application")
     IE.Visible = True 'IE画面を開く

     '2行目～記載されている行まで見ていく
     For gyou = 2 To Cells(Rows.Count, "C").End(xlUp).Row
         IE.Navigate Replace(Replace(MapURL, "<<<", WorksheetFunction.EncodeURL(Cells(1, "B").Value)), ">>>", WorksheetFunction.EncodeURL(Cells(gyou, "C").Value))
         While IE.Busy Or IE.readyState <> 4
             Sleep 3000
             DoEvents
         Wend
         For Each span In IE.Document.getElementsByClassName("xB1mrd-T3iPGc-iSfDt-duration delay-light gm2-subtitle-alt-1")
             Pos = InStr(span.innerText, "分")
             If Pos > 0 Then
                 Cells(gyou, "L").Value = Left(span.innerText, Pos)
                 Exit For
             End If
         Next
     Next
     IE.Quit  'IEのウィンドウを閉じる
     Set IE = Nothing  '生成したIEオブジェクトを破棄
     MsgBox "全ビルの移動時間の集計が終わりました。"
 End Sub
（ろっくん） 2022/01/19(水) 10:14

半平太様
　ご回答ありがとうございます！お陰様で無事に最速ルートの移動時間を取得することができました！！感動です！！ありがとうございました！！

ろっくん様
　ご回答ありがとうございます！勉強不足でURLをエクセル上に表示して検索する方法しか思いつかなかったので助かりました！しかも車ボタンを押す時間まで省略できるとは、、、ありがとうございました！！
（ひこ） 2022/01/19(水) 21:13

コメント返信：

[ 一覧(最新更新順) ]

[[20220118205238]] 『『Googleマップで車で行く距離と時間を抽出する方』（ひこ） ページの最後に飛ぶ

[[20220118205238]]　『『Googleマップで車で行く距離と時間を抽出する方』（ひこ）　ページの最後に飛ぶ