ｙａｈｏｏ 地図 ソースを取得したい VBA

質問

ｙａｈｏｏで地図を検索し、自分のブログやサイトに張り付けるためのソースを取得したい

ヤフーのトップページから住所を入力して地図を表示させることまでは出来たのですが、
「この地図をブログ、サイトにはりつける」をクリックして、ソースを表示させ、取得することができません。

Dim objIE As InternetExplorer
Sub Sample()
Dim myObj As Object

Set objIE = CreateObject("InternetExplorer.application")

objIE.Visible = True
objIE.navigate "http://www.yahoo.co.jp/"

Call 待つ

objIE.document.getElementById("csearch").Click
objIE.document.forms(0).elements("p").Value = "千代田区丸の内１－９－１"
objIE.document.forms(0).submit

Call 待つ

Set objIE = Nothing
End Sub

Sub 待つ()
Do While objIE.Busy = True
DoEvents
Loop
Do While objIE.document.readyState <> "complete"
DoEvents
Loop
End Sub

ここまでは問題なくできます。

For Each myObj In objIE.document.all.tags("div")
If myObj.ID = "urlBtn" Then
objIE.navigate myObj.all(0).href
Exit For
End If
Next

これを入れることで、
「この地図をブログ、サイトにはりつける」
をクリックするのかな、と思いましたが、
objIE.navigate myObj.all(0).href
を通過しても何も起こりません。

結果として、VBAで
<script type='text/javascript' charset='UTF-8' src='http://map.yahooapis.jp/MapsService/embedmap/V2/?cond=p%3A%E5%8D%83%E4%BB%A3%E7%94%B0%E5%8C%BA%E4%B8%B8%E3%81%AE%E5%86%85%EF%BC%91%EF%BC%8D%EF%BC%99%EF%BC%8D%EF%BC%91%3Blat%3A35.68118548%3Blon%3A139.76875395%3Bei%3AUTF-8%3Bv%3A2%3Bsc%3A3%3Bdatum%3Awgs%3Bgov%3A13101055001%3Bz%3A18%3Bs%3A1407012295a3fac6d822a802dc26aec780294c76da%3Blayer%3Apl%3Bspotnote%3Aon%3B&p=%E5%8D%83%E4%BB%A3%E7%94%B0%E5%8C%BA%E4%B8%B8%E3%81%AE%E5%86%85%EF%BC%91%EF%BC%8D%EF%BC%99%EF%BC%8D%EF%BC%91&zoom=18&lat=35.68118548&lon=139.76875395&pluginid=place&z=18&mode=map&active=true&layer=place&home=on&hlat=35.68118548&hlon=139.76875395&pointer=off&pan=off&ei=utf8&v=3&datum=wgs&width=480&height=360&device=pc&isleft='></script>

を取得したいのですが、可能でしょうか？

よろしくお願いします。

回答No.2

eden3616 · ベストアンサー

No1に追加です。
ウィンドウを操作するのでアクティブにしたほうが良いですね。

2行目に以下を追加
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

SendKeysでの操作前に以下を追加
SetForegroundWindow (objIE.hWnd)

追記
SendKeysなので「objIE.Visible = False」では動作しません・・・・。
待機時間の「Call Sleep(1000)」は適度にセットしてください・・・・。

お礼

ご回答ありがとうございました。

回答No.1

eden3616

Javascriptによりポップアップしたウィンドウへの操作が分からなかったので
リンククリック後の処理はSendKeysで操作になりますが。

■VBAコード

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim objIE As Object
Dim buf As String

Sub Sample()
Dim myObj As Object
'追加
Dim i As Integer

Set objIE = CreateObject("InternetExplorer.application")

objIE.Visible = True
objIE.navigate "http://www.yahoo.co.jp/"

Call 待つ

objIE.Document.getElementById("csearch").Click
objIE.Document.forms(0).elements("p").Value = "千代田区丸の内１－９－１"
objIE.Document.forms(0).submit

Call 待つ

'リンクClick
For i = 0 To objIE.Document.Links.Length - 1
If InStr(objIE.Document.Links(i).outerHTML, "URLのコピー") > 0 Then
objIE.Document.Links(i).Click
End If
Next i

'操作
Call Sleep(1000)
SendKeys "^f", True
SendKeys "この地図をブログ、サイトにはりつける", True
SendKeys "{ENTER}", True
SendKeys "{TAB}", True
Call Sleep(1000)
SendKeys "{TAB}", True
Call Sleep(1000)
SendKeys "^a", True
SendKeys "^c", True
Call Sleep(1000)
objIE.Quit

'表示
Call getCB
MsgBox buf

Set objIE = Nothing
End Sub

Sub 待つ()
Do While objIE.busy = True
DoEvents
Loop
Do While objIE.Document.readyState <> "complete"
DoEvents
Loop
End Sub

Sub getCB()
'Clipboardにあるテキストデータを取得
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.GetFromClipboard
buf = .GetText
End With
End Sub

参考URL：

http://www.ken3.org/vba/backno/vba170.html

お礼

ご回答ありがとうございました。