[[20121015095611]]　『Googleマップで(車で行く)距離と時間を調べ、抽出』（きさね）　ページの最後に飛ぶ

『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
(???)

???様　半平太様　ありがとうございました。

半ばあきらめておりましたが、???様のコードでうまくいきました。
本当にありがとうございました！！

(きさね)

コメント返信：

[ 一覧(最新更新順) ]

[[20121015095611]] 『Googleマップで(車で行く)距離と時間を調べ、抽出』（きさね） ページの最後に飛ぶ

[[20121015095611]]　『Googleマップで(車で行く)距離と時間を調べ、抽出』（きさね）　ページの最後に飛ぶ