エクセルVBAで、IEからコピーするには

質問

エクセル2000,win2000,IE6です。
次のような、コードを書きました。

Sub t03ccc()

Dim objIE As Object 'IE オブジェクト参照用
Dim objShell As Object 'Shell オブジェクト参照用
Dim objWindow As Object 'Window オブジェクト参照用

Set objShell = CreateObject("Shell.Application")
For Each objWindow In objShell.Windows '起動中のタイトルを探して。
If Left(objWindow.document.Title, 7) = "Office系" Then
Set objIE = objWindow 'オブジェクトを代入
Msg = "Office系"
Exit For
End If
Next
If Msg <> "Office系" Then
MsgBox "・・・スクリーニング結果一覧・・・がありません"
Exit Sub
End If

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

Sheets("Sheet3").Select
Rows("1:200").ClearContents
Range("A1").Select
ActiveSheet.Paste

'''' objIE.Quit
Set objIE = Nothing
Set objShell = Nothing
Set objWindow = Nothing

End Sub

これで、エクセルとIEしか開いてないときは巧くいくのですが、
エクスプローラーを同時に開くと実行時エラー438が出ます。

よろしくお願いします。

回答No.1

lul · ベストアンサー

エクスプローラーにはTitle無かったと思います、その為エラーがでますね。
回避策はソースに2行追加すれば大丈夫だと思います。
For Each objWindow In objShell.Windows '起動中のタイトルを探して。
If InStr(LCase(objWindow.FullName), "iexplore.exe") Then '←この部分を追加
If Left(objWindow.Document.Title, 7) = "Office系" Then
Set objIE = objWindow 'オブジェクトを代入
Msg = "Office系"
Exit For
End If
End If　'←この部分を追加(end if)
Next
これで、対象がIEで無ければその後の判定（Titleをチェックしたり）はしないので、エラーも無くなると思いますよ。

お礼

ご教授、ありがとうございます。
巧くいきました。

実は、ON ERRで逃げ、エクスプローラーを閉じて再度実行させようかなとも思っていたのですが。

本当に助かりました。