サイトのページの全体をコピーしてエクセルに貼り付け

質問

サイトのページの全体をコピーしてエクセルに貼り付けたいのですが
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1341770528
を参考にしたのですが

Sub test()
Dim objIE As Object

Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Navigate "http://www.goo.ne.jp/"

While objIE.ReadyState <> 4
DoEvents
Wend

objIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT '17,0
objIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT '12
DoEvents

Workbooks.Add
DoEvents

Range("A1").Select
ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, DisplayAsIcon:=False
End Sub

をしたのですが、うまくコピーできていません。
一番最後にコピーした文字がセルに張りついてしまいます。
なぜでしょうか？

回答No.1

ki-aaa · ベストアンサー

こんにちわ

例示されているURLを開いて、手動でCtrl+Aしても全選択されません。

いろいろ試した結果、マウスで右クリック→{ESC}→Ctrl+A　だと選択できました。

OSはXP、IE8、Excel2000では、うまくいきましたがほかの組み合わせだと?です。

Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Sub mouse_event Lib "user32.dll" _
(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _
ByVal dwData As Long, ByVal dwExtraInfo As Long)

Public Const MOUSEEVENTF_ABSOLUTE = &H8000&
Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_RIGHTDOWN = &H8

Sub test()
Dim objIE As Object

Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Navigate "http://www.goo.ne.jp/"

While objIE.ReadyState <> 4 Or objIE.Busy
DoEvents
Sleep 100
Wend

'Sleep 1000・・・一秒待つ
Sleep 100
'マウスのポインタを中央付近に移動させ、右クリックする
Call mouse_event(MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, 30000, 30000, 0, 0)
Call mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
Sleep 2000
DoEvents

'{ESC}を押す
SendKeys "{ESC}"
Sleep 3000
DoEvents

'objIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT '17,0
'objIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT '12

objIE.ExecWB 17, 0 'OLECMDID_SELECTALL = 17 全てを選択
objIE.ExecWB 12, 0 'OLECMDID_COPY = 12 コピー

Sleep 1000
DoEvents
Workbooks.Add
Sheets("Sheet1").Select
Range("C1").Select
ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, DisplayAsIcon:=False

objIE.Quit

End Sub

お礼

ありがとうございます。