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

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

　

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

下記の過去にあった『Googleマップで車で行く距離と時間を抽出する方法』の記事を参考にマクロを実行しましましたが、『実行時エラー424 オブジェクトが必要です。』というエラーがでます。
となたか解決方法ご存じないでしょうか。

Excel2019
Windows10

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
『Googleマップで(車で行く)距離と時間を調べ、抽出する方法』（きさね）
B列に住所一覧があります。GoogleマップでA1に入力されている住所との距離と時間を調べ、それぞれC列D列に抽出することはできるのでしょうか。
Excel2007
Windows Vista
回答が付かないようなので、ソースを抜き出すまでのサンプル。
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub test()

    Dim IE As Object
    Dim i As Long
    Set IE = CreateObject("InternetExplorer.application")
    IE.Visible = True
    IE.Navigate "http://maps.google.co.jp/maps"
    Call sWait(IE)
    With IE.document
        .all("d_launch").Click
        Call sWait(IE)
        .all("dir_d_btn").Click
        .all("d_d").Value = Cells(1, "A").Text
        .all("d_daddr").Value = Cells(1, "B").Text
        .all("d_sub").Click
        Call sWait(IE)
        For i = 0 To 4
            Cells(1, i + 5).Value = .forms(i).outerhtml
        Next i
    End With
    IE.Quit
    Set IE = Nothing
End Sub
Sub sWait(OBJ As Object)
    Sleep 10000
    While OBJ.readyState <> 4
        While OBJ.Busy = True
            DoEvents
            Sleep 1000
        Wend
    Wend
End Sub
(???)
きさね様　スレッドお借りします。
申し訳御座いません。
???様
この後、どのようにしたら
時間を抜き出せますでしょうか？
ヒントだけでも頂けますでしょうか？
（閲覧者a)
幾つかの条件で実行し、表示される距離と同じ情報がいずれかのHTMLに含まれていないか調べる。
見つかったなら、その情報の直前にあるユニークな文字列を決めて、Instr関数で探しましょう。
(???)
???様、ありがとうございます。
返事が遅くなり申し訳ございませんでした。
HTML内を探しましたが、それらしきものを見つけることができませんでした。
どなたか、分かる方がいましたら、教えて頂けますでしょうか。
（きさね）
Googleのソースは難しい。HTMLソースを見てみたが、怪しいのは"<INPUT value=50"で始まる箇所。
ただ、これがボタンとして行き先と距離の文字列に使われるのかどうかまでは判らず。
地図の座標データかも？
または、画像化して表示されているのかも知れない。この場合は文字列を抜き出せない。
いずれにせよ難しそうなので、Google以外の地図サービスを検討してはどうでしょう？
(???)
 (???)さんのコードを一部変更させていただきます。
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Sub test()
     Dim IE As Object
     Dim i As Long
     Dim tags As Object
     If WorksheetFunction.CountA(Range("A1:B1")) < 2 Then Exit Sub
     Set IE = CreateObject("InternetExplorer.application")
     IE.Visible = True
     IE.Navigate "http://maps.google.co.jp/maps"
     Call sWait(IE)
     With IE.Document
         .all("d_launch").Click
         Call sWait(IE)
         .all("dir_d_btn").Click
         .all("d_d").Value = Cells(1, "A").Text
         .all("d_daddr").Value = Cells(1, "B").Text
         .all("d_sub").Click
         Call sWait(IE)
         Range("C1:D1").ClearContents
         i = 2
         For Each tags In .getElementsByTagName("SPAN")
             If (tags.outerhtml Like "<SPAN>*km</SPAN>" Or tags.outerhtml Like "*時間*分*") And _
                 InStr(tags.outerhtml, "現在の交通状況") = 0 Then
                     i = i + 1
                     Cells(1, i).Value = Split(Mid(tags.outerhtml, 7, 30), "<")(0)
             End If
             If i = 4 Then Exit For
         Next
     End With
     IE.Quit
     Set IE = Nothing
 End Sub
 Sub sWait(OBJ As Object)
     Sleep 10000
     While OBJ.readyState <> 4
         While OBJ.Busy = True
             DoEvents
             Sleep 1000
         Wend
     Wend
 End Sub
 ※余り深入りしたくないので、私のレスはこれのみです。
 (半平太) 2012/10/18 20:27
半平太さん、よいヒントになりました。ありがとう。
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub test()
    Dim IE As Object
    Dim i As Long
    Dim j As Long
    Set IE = CreateObject("InternetExplorer.application")
    IE.Visible = True
    IE.Navigate "http://maps.google.co.jp/maps"
    Call sWait(IE)
    Sleep 20000
    With IE.Document
        .all("d_launch").Click
        Call sWait(IE)
        Sleep 20000
        .all("dir_d_btn").Click
        Call sWait(IE)
        For i = 1 To Cells(Rows.Count, "B").End(xlUp).Row
            .all("d_d").Value = Cells(1, "A").Text
            .all("d_daddr").Value = Cells(i, "B").Text
            .all("d_sub").Click
            Call sWait(IE)
            Sleep 10000
            For j = 0 To .getElementsByTagName("SPAN").Length - 1
                If Right(.getElementsByTagName("SPAN")(j).innerHTML, 2) = "km" Then
                    Cells(i, "C").Value = .getElementsByTagName("SPAN")(j).innerHTML
                    Cells(i, "D").Value = .getElementsByTagName("SPAN")(j + 1).innerHTML
                    Exit For
                End If
            Next j
        Next i
    End With
    IE.Quit
    Set IE = Nothing
End Sub
Sub sWait(OBJ As Object)
    Sleep 1000
    While OBJ.readyState <> 4
        While OBJ.Busy = True
            DoEvents
            Sleep 100
        Wend
    Wend
    Sleep 1000
End Sub
(???)
???様　半平太様　ありがとうございました。
半ばあきらめておりましたが、???様のコードでうまくいきました。
本当にありがとうございました！！
(きさね)

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

---

 >『実行時エラー424 オブジェクトが必要です。』というエラーがでます。
 どの部分でエラーが出るのか提示したら。
 (きさね)さんは「???様のコードでうまくいきました。」と言っているのであなたと仕様条件が違うのでは。
 >回答が付かないようなので
 どういうこと。再投稿ということ。 
 私には回答権はありません。
（りん） 2022/01/05(水) 22:06

---

コメント返信：

---

[ 一覧(最新更新順) ]

---

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