エクセルVBA IEを操作して自動車ルート検索自動化

エクセルのBVAでIEを使って自動車のルート検索をして距離と高速料金をエクセルのシートに抽出したいと考えています。

＜作業の流れ＞
・エクセルシートのA1セルに郵便番号をハイフン無しで手入力
・マクロを起動（下記参照）
・IEで「ジオコーディング」サイトが開きエクセルシートのB2とC2セルに
ゴール地点となる緯度と経度が抽出される（ちなみに運用上エクセルシートに抽出されなくてもよい）
（ここまでは出来ました）

・IEで「ナビタイム」サイトを開きます
・車でのルートを検索してエクセルシートのD2とE2セルに距離と高速料金（ETC）が抽出される
（これもできました）

問題は「ジオコーディング」で抽出したゴール地点の緯度と経度を「ナビタイム」を開く時の
URLの中に挿入？置き換え？して入れ込み「ナビタイム」でルートを検索する事ができません.
----------------------------------------------------------------
Sub 自動車ルートの距離と高速料金算出()
'ジオコーディングで緯度と経度を算出して取得する
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Visible = True
Dim strSearchWord As String '検索ワード
Dim yuubin As Range
Set yuubin = Cells(Rows.Count, 1).End(xlUp) '表の郵便番号の最終行を選択
strSearchWord = yuubin
.navigate "https://www.geocoding.jp/?q=" & strSearchWord
Do While .Busy = True Or .ReadyState <> 4
DoEvents
Loop

Dim ido As Variant '緯度
Dim keido As Variant '経度
ido = objIE.document.all.tags("b")(2).outerText '緯度の値を取得する
keido = objIE.document.all.tags("b")(1).outerText '経度の値を取得する
Cells(2, 2).Value = ido　'プログラム上で連動するならシートへの抽出は不要
Cells(2, 3).Value = keido　'プログラム上で連動するならシートへの抽出は不要
End With

'ナビタイムでルート検索して距離と高速料金を取得する
Dim objIE2 As Object
Set objIE2 = CreateObject("InternetExplorer.Application")
With objIE2
.Visible = True
Dim adoresu As Variant

'※この中の緯度と経度の値を「ジオコーディング」で取得したゴール地点の値にしたい
'ここが繋がっていません。
'（スタート地点の緯度経度は固定でよいです）
'↓
Address = "136.916786,""road-type"":""default"",""lat"":35.074385}"

.navigate "https://www.navitime.co.jp/maps/routeResult?star …{""name"":""スタート地点"",""lon"":137.231326,""road-type"":""default"",""lat"":35.354389}&goal={""name"":""ゴール地点"",""lon"":" & Address

　 Do While .Busy = True Or .ReadyState <> 4
DoEvents
Loop
.Top = 0
.Left = 300
.Width = 550
.Height = 1100
Do
On Local Error Resume Next
Err.Clear
Cells(2, 4) = .document.getElementsByClassName("value")(0).outerText
Cells(2, 5) = .document.getElementsByClassName("value-etc-fare")(1).outerText
If Err.Number = 0 Then Exit Do
Loop
On Local Error GoTo 0
End With
End Sub
-------------------------------------------------------------------
どの様に、すれば良いか壁にぶつかっています。
アドレス頂けます様、宜しくお願い致します。

No.6 ベストアンサー 回答者： Qchan1962 回答日時： 2020/03/08 05:21

＃５です。

５に回答したような事では無いのですね。全体を検証してなんとなく。。
まず、
　keido = objIE.document.all.tags("b")(0).outerText '経度の値を取得する
　ido = objIE.document.all.tags("b")(1).outerText '緯度の値を取得する
この取得が安定しませんでした。あ、("b")(0)と（1）にしました。。いずれにしても、期待通りに取得できるのは10回のうち1度くらいでした。
原因は、確かめていません。
なので、getElementsByClassName("nowrap") で抽出して、文字列を加工して変数に入れるのが安定していました。
（力技みたいですけど、20回ほど試して1回取得を失敗しましたnode
。Application.Wait Now + TimeValue("00:00:02")を
挿入したら20回で失敗なしでしたが、念のため変数が空の場合の対応を講じれば、良いと思います。

また、この出力も思惑と違う値が返されるようです。
.document.getElementsByClassName("value")(0).outerTextは、OK
.document.getElementsByClassName("value-etc-fare")(1).outerText　は上記と同じ項目の金額ならやはり(0)では？

下記の処理は、考え直した方が良いかも知れません。エラーが発生すると抜けられません。
Do
On Local Error Resume Next
Err.Clear
Cells(2, 4) = .document.getElementsByClassName("value")(0).outerText
Cells(2, 5) = .document.getElementsByClassName("value-etc-fare")(1).outerText
If Err.Number = 0 Then Exit Do
Loop

なかなか面白い(郵便番号で旅してみました)ので検証しているうちに作ってしまいました。。。
結果抽出はまだ課題がありそうなので、途中段階の参考として
整理して変えている部分もあるので、、outerTextをinnerTextとか、、

Sub 自動車ルートの距離と高速料金算出()
'ジオコーディングで緯度と経度を算出して取得する
Dim objIE As Object
Dim Str As Object
Dim strSearchWord As String　'検索ワード
Dim yuubin As Range
Dim ido As Variant, keido As Variant　　'緯度' 経度
Dim tmp As String
　　Set objIE = CreateObject("InternetExplorer.Application")
　　Set yuubin = Cells(Rows.Count, 1).End(xlUp)　　'表の郵便番号の最終行を選択
　　strSearchWord = "5410001"　　'yuubin　
　　With objIE
　　　　.Visible = True
　　　　.navigate "https://www.geocoding.jp/?q=" & strSearchWord
　　　　Call WaitResponse(objIE)　　'読み込み待ち
　　　　For Each Str In .document.getElementsByClassName("nowrap")　　'ソースより判断
　　'　　　　Debug.Print Str.innerText　
　　　　　　If InStr(Str.innerText, "緯度") > 0 Then
　　　　　　　　tmp = Mid(Str.innerText, InStr(Str.innerText, " ") + 1)
　　　　　　　　ido = Left(tmp, InStr(tmp, " ") - 1)
　　　　　　　　keido = Right(Str.innerText, InStr(StrReverse(Str.innerText), " ") - 1)
　　'Debug.Print ido; "<>"; keido
　　　　　　End If
　　　　Next Str
　　End With
　　objIE.Quit　　　　　　　 'IEを閉じる
　　Set objIE = Nothing

　　'ナビタイムでルート検索して距離と高速料金を取得する
　　Dim i As Long
　　Dim Address As String, TargetURL As String
　　Set objIE = CreateObject("InternetExplorer.Application")
　　Address = keido & ",""road-type"":""default"",""lat"":" & ido & "}"
　　'Debug.Print Address
　　TargetURL = "https://www.navitime.co.jp/maps/routeResult?star …
　　TargetURL = TargetURL & "{""name"":""スタート地点"",""lon"":137.231326,""road-type"":""default"",""lat"":35.354389}&goal={""name"":""ゴール地点"",""lon"":" & Address
　　'Debug.Print TargetURL
　　With objIE
　　　　.Visible = True
　　　　.navigate TargetURL
　　　　.Top = 0
　　　　.Left = 300
　　　　.Width = 550
　　　　.Height = 1100
　　　　Call WaitResponse(objIE)　　'読み込み待ち
　　　　
　　　　Do
　　　　　　i = i + 1
　　　　　　On Local Error Resume Next
　　　　　　Err.Clear
　　　　　　Cells(2, 4) = .document.getElementsByClassName("value")(0).innerText
　　　　　　Cells(2, 5) = .document.getElementsByClassName("value-etc-fare")(0).innerText
'　　　　　　Dim s1, s2, s3, s4
'　　　　　　s1 = .document.getElementsByClassName("value")(0).innerText
'　　　　　　s2 = .document.getElementsByClassName("value-etc-fare")(0).innerText
'　　　　　　s3 = .document.getElementsByClassName("value")(2).innerText
'Debug.Print s1; "<>"; s2; "<>"; s3
　　　　　　If Err.Number = 0 Then Exit Do
　　　　　　Application.Wait Now + TimeValue("00:00:01")
　　　　　　DoEvents '読み込めない時がある為
　　　　Loop Until i = 10
　　　　On Local Error GoTo 0
　　End With
　　objIE.Quit　　　　　　　 'IEを閉じる
　　Set objIE = Nothing
End Sub
Sub WaitResponse(objIE As Object)
　　Do While objIE.Busy = True Or objIE.ReadyState < READYSTATE_COMPLETE
　　　　DoEvents
　　Loop
　　Application.Wait Now + TimeValue("00:00:02")
End Sub

検証用のコードは、削除してください。

この回答へのお礼

Qchan1962さーん(≧∇≦)/
すごいです。
途中段階だなんて、出来てしまっているではないですか～
コピぺして動かしてみたら見事に動きましたよ。
ありがとうございます。

エラー回避の事も考えて頂いて、私ではたどり着けない境地です。
…私では改良もままなりません。
＞結果抽出はまだ課題がありそうなので
とは、どのような事例なのでしょうか？

ま～それはともかく、本当にありがとうございました。
頂いたコードを元に勉強してスキルアップして問題に対処していきます。
…また、お願いするかもしれませんが…

ありがと～～

お礼日時：2020/03/08 16:46

No.5 回答者： Qchan1962 回答日時： 2020/03/08 01:06

＃１です。

パット見で回答してしまいましたね。
" の数は、イミディエイトウィンドウに出力した時に希望する文字列になっているのかなと思い回答した次第です。
申し訳ないので、ちょっと検証してみました。
取り敢えず下記の内容で検証しました。
全体を検証するのは、難儀なので勘弁ですが、エラー部分だけ　結果としては、{""name"の前の "を加えました
変な変数の入れ方していますが、部分検証する為の残骸です。

Sub testIE()
Dim objIE As InternetExplorer
Dim TargetURL As String
Dim s, Address
　　Address = "136.916786,""road-type"":""default"",""lat"":35.074385}"
　　'　　Debug.Print Address
　　s = "https://www.navitime.co.jp/maps/routeResult?star …
　　'　　Debug.Print s
　　s = s & "{""name"":""スタート地点"",""lon"":137.231326,""road-type"":""default"",""lat"":35.354389}&goal={""name"":""ゴール地点"",""lon"":" & Address
　　'　　Debug.Print s
　　TargetURL = s　　　　　　'キーワード
　　Set objIE = CreateObject("Internetexplorer.Application")　　'新しいIEオブジェクトを作成してセット
　　objIE.Visible = True　　 'IEを表示
　　objIE.navigate TargetURL　　'IEでURLを開く
　　Do While objIE.Busy = True Or objIE.ReadyState < READYSTATE_COMPLETE
　　　　DoEvents
　　Loop
　　'　　objIE.Quit　　　　　　　 'IEを閉じる
　　Set objIE = Nothing
End Sub

私の環境では、しっかり遷移しました。
IE 11　Windows10 64bit Excel2013 32bit (2016未検証）

この回答へのお礼

Qchan1962さん
ありがとうございます。
知識不足のため、色々と気を使って頂いたようで申し訳ありません。
Qchan1962さん
ちょっとお待ちくださいね～
アドバイス＆既次の回答が答えなのかもしれませんが
教えて頂いた事を確認するにも、理解力がー(≧∇≦)努力します！
取り急ぎ「色々助かります(Ｔ▽Ｔ)ありがとうございます」

お礼日時：2020/03/08 10:00

No.4 回答者： fujillin 回答日時： 2020/03/07 22:22

No3です

こちらに確認できる環境がないのと、質問者様の状況が今一つよくわからないので、ほとんど推測になってしまいますが・・・

＞str= """lat"":" & ido & ",""lon"":" & keidoを試みたのですが…
＞コンパイルエラー「引数は省略出来ません」っとでてしまいます。
それって、VBAのエラーですか？
今、確かめることはできないのですが、多分、文法は間違っていないと思うのですけれど・・・？
センテンス自体は単なる文字連結なので、「引数」に当たるものは無いと思いますし……

もしも、サイトがエラーを出しているのなら、クエリが全体で見て正しくないということではないでしょうか？

＞緯度と経度の値は取得できているとおもうのですが、
Debug.Print等を利用して確認すれば、直ぐにわかると思いますけれど。
クエリ全体も同様にして、間違いないかを確認して見るのが宜しいかと思います。

＞そもそも上の記述だけでは、ダメなのでしょうか？
クエリ部の構成は前回の回答通りの内容が揃っていないと結果が得られないと想像します。
（省略できる項目がまだあるかも知れませんが…）

＞取得データが無く無限エラーになってしまいます。
「無限エラー」という意味がわかりかねますが、対象DOMが存在しない場合でも、取得処理ではエラーにならないはずです。（nullなどがかえされるはず）
そのままvalueやtext等の属性値を取得しようとするとエラーになりますので、値の取得前にDOMの存在を確認するようにすれば、エラーは回避できるものと推測します。

この回答へのお礼

fujillinさん
ありがとうございます。
追加の問題にも答えて頂き助かりました。
また、アドバイスを元に色々調べてみます。

お礼日時：2020/03/08 09:41

No.3 回答者： fujillin 回答日時： 2020/03/06 22:41

No2です。

No2で書き忘れていたことがありました。

URIはそのままでも動作する可能性は高いですが、念のため、エンコードしておくことをおすすめしておきます。

この回答へのお礼

fujillinさん
前回に続いてまた助けてくれて、ありがとうございます。
頂いたアドバイスでやってみます。

お礼日時：2020/03/07 11:12

No.2 回答者： fujillin 回答日時： 2020/03/06 16:06

こんにちは。

テストできる環境がないので、ご提示のコードを斜めに見ただけですが……

＞これもできました
現状のコードが意図通りに動作していると仮定できるとして、
＞問題は「ジオコーディング」で抽出したゴール地点の緯度と経度を「ナビタイム」
＞を開く時のURLの中に挿入？置き換え？できません
という点だけのご質問と解釈しました。

URIは普通の文字列ですので、クエリ部の作成も文字列操作で行えば可変の内容として作成が可能です。

変数 ido、keido に目的とする経緯度が文字列で取得できているなら、単純な文字列連結で、
　str= """lat"":" & ido & ",""lon"":" & keido
のような要領でも作成できますし、定型文の一部を変更するという考え方で、
　str= """lat"":*lat*,""lon"":*lon*"
　str=Replace(Replace(str,"*lat*",ido),"*lon*",keido)
のような処理でも同様の結果を得ることができると思います。

この回答へのお礼

fujillinさん
こんにちは
アドバイスありがとうございます。

fujillinさんが解釈してくれた通りの所がわからないのです。
教えて頂いた
str= """lat"":" & ido & ",""lon"":" & keidoを試みたのですが…
コンパイルエラー「引数は省略出来ません」っとでてしまいます。
緯度と経度の値は取得できているとおもうのですが、
そもそも上の記述だけでは、ダメなのでしょうか？
記述場所が悪いのでしょうか？

また、プログラムの最後から数えて6行目の
Cells(2, 5) = .document.getElementsByClassName("value-etc-fare")(1).outerText
で高速料金（ETC)代を取得しているのですが、
スタート地点からゴール地点が近い場合高速を利用ルートになるため
取得データが無く無限エラーになってしまいます。

お手数ですが、もう少しアドバイスをおねがいできないでしょうか

お礼日時：2020/03/07 17:47

No.1 回答者： Qchan1962 回答日時： 2020/03/06 15:34

あてずっぽうで確認していませんが、

"の数　合ってますか？"""では？（場所によると思いますが）

この回答へのお礼

あれー？なんか間違ったかなー？
何処でしょうか？
確認してみます。
Qchan1962さん指摘ありがとうございます。

お礼日時：2020/03/07 10:55