こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

yahoo 地図 ソースを取得したい VBA

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

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

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 = "千代田区丸の内1-9-1"
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&amp;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&amp;zoom=18&amp;lat=35.68118548&amp;lon=139.76875395&amp;pluginid=place&amp;z=18&amp;mode=map&amp;active=true&amp;layer=place&amp;home=on&amp;hlat=35.68118548&amp;hlon=139.76875395&amp;pointer=off&amp;pan=off&amp;ei=utf8&amp;v=3&amp;datum=wgs&amp;width=480&amp;height=360&amp;device=pc&amp;isleft='></script>

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

よろしくお願いします。

投稿日時 - 2014-08-03 05:53:13

QNo.8702488

暇なときに回答ください

質問者が選んだベストアンサー

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)」は適度にセットしてください・・・・。

投稿日時 - 2014-08-03 13:00:23

お礼

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

投稿日時 - 2014-08-27 23:03:11

このQ&Aは役に立ちましたか?

5人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

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 = "千代田区丸の内1-9-1"
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

投稿日時 - 2014-08-03 12:34:46

お礼

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

投稿日時 - 2014-08-27 23:03:12

あなたにオススメの質問