ExcelVBAでIE画面データの取り込みかた

質問

http://www.geocities.co.jp/SiliconValley-Bay/1992/excel/web.html

このページの記述を見てYahoo!のページはとりこめました。
ただ、新たにURLを指定してIEを立ち上げるのではなく、すでに開いているIE画面のデータを取りこむにはどのように直せばよいのでしょうか？
ご教授ください。

Option Explicit
Sub test()

　Dim ie As Object
　Dim x As Object

　Set ie = CreateObject("internetexplorer.application")
　Set ie = GetObject("", "InternetExplorer.application")
　ie.Visible = False
　ie.navigate ("http://www.yahoo.co.jp/")

　While ie.Busy Or ie.ReadyState <> 4: DoEvents: Wend

　Set x = New DataObject
　x.SetText ie.document.documentElement.innerText
　x.PutInClipboard
　ActiveSheet.PasteSpecial

　Set x = Nothing
　Set ie = Nothing

End Sub

回答No.3

ki-aaa · ベストアンサー

前回の回答を少し変更します。

If ie.LocationURL Like "*yahoo.co.jp*" Then
　↓
If ie.LocationURL Like "*http://*" Then

でわ、首尾よく行きますように祈っています。

お礼

なるほどワイルドカードでしね。
ありがとうございました。
取り込みたい画面以外にもＩＥが開いていると、予期しないアクティブではない画面をコピーするようですがＩＥが一つだけではうまくいきました。
どうやってアクテイブ、というのかどうかわかりませんが、最後に開いたＩＥ画面をとり込めるかについては別の質問を立てようと思います。

回答No.2

ki-aaa

こんにちわ
これでどうですか。

Sub test1() 'URLを調べる
Dim shl As Object
Dim ie As Object
Dim x As Object
Dim ファイル有り As Boolean

ファイル有り = False
Set shl = CreateObject("Shell.Application")

For Each ie In shl.Windows()
If ie.LocationURL Like "*yahoo.co.jp*" Then
'または、　If ie.LocationURL = "http://auctions.yahoo.co.jp/" Then
ファイル有り = True
Exit For
End If
Next

If ファイル有り Then
Set x = New DataObject
x.SetText ie.document.documentElement.innerText
x.PutInClipboard
ActiveSheet.PasteSpecial
End If

Set x = Nothing
Set ie = Nothing
Set shl = Nothing
End Sub

お礼

なんどもご回答ありがとうございます。
ご教示のコードでヤフーのデータ貼り付けは出来ました。
ありがとうございます。
ただ、わたしの質問のしかたが悪かったようです。
実際にはデータをコピーしたいIEの画面が何であるかはその都度異なるのです。
つまり、そのとき開いている（アクティブになっている）IE画面のデータをエクセルに張りたいのです。
そのためURLの指定が出来ないのです。
どうしたらよいのでしょうか？

回答No.1

ki-aaa

こんにちわ。これを利用してください。

Sub test() 'URLを調べる
Dim shl As Object
Dim wnd As Object
Set shl = CreateObject("Shell.Application")
For Each wnd In shl.Windows()
Debug.Print wnd.LocationURL
Next
Set wnd = Nothing
Set shl = Nothing
End Sub

Sub test111() 'タイトルを調べる
Dim shl As Object
Dim wnd As Object
Set shl = CreateObject("Shell.Application")
For Each wnd In shl.Windows()
If InStr(LCase(wnd.FullName), "iexplore.exe") Then
Debug.Print wnd.document.Title
End If
Next
Set wnd = Nothing
Set shl = Nothing
End Sub

また、グーグルで、"VBA 既に開いているIE"　で検索すると、必要な情報が得られます。

お礼

ありがとうございます。
せっかく教えていただきましたがうまくいきません。

> Sub test()'URLを調べる

で開いているサイトのURLは取得できました。
そのURLから

x.PutInClipboard
　ActiveSheet.PasteSpecial

にどうやってもってくるのかがわかならいのです。

すみません。