複数開いているWebページのタイトルを特定する

今、あるボタンから開いたWebページを選択し、
メールアドレスを入力するようにしたいのですが、
タイトルがうまく所得できません。
お分かりの方居られましたら、ご教示下さい。


Dim Fremawatch_path  As Variant
Dim Google_Login, Google_password As Object

Application.ScreenUpdating = False

Set objIE = CreateObject("Internetexplorer.Application")
objIE.Visible = True

ThisWorkbook.Activate
Sheets("Controller").Select
Fremawatch_path = ""
Fremawatch_path = Worksheets("Controller").Range("H5")


objIE.navigate Fremawatch_path

Do While objIE.Busy = True Or objIE.readyState < 4
    DoEvents '処理待ち
Loop

Application.Wait Now + TimeValue("0:00:01") 'HTMLの読み込み待ち

'Dim htmlDoc As HTMLDocument
Set htmlDoc = objIE.document

Debug.Print htmlDoc.Title 'タイトル

Dim hiduke As IHTMLElement

Dim ritsu As Object
Set ritsu = htmlDoc.getElementsByTagName("button").Item(0)
ritsu.Click⇒ボタン押す

Do While objIE.Busy = True Or objIE.readyState < 4
    DoEvents '処理待ち
Loop

Application.Wait Now + TimeValue("0:00:01") 'HTMLの読み込み待ち

Dim colSh, win As Object

Set colSh = CreateObject("Shell.Application")

For Each win In colSh.Windows

    If TypeName(win.document) = "HTMLDocument" Then⇒ｴﾗｰ発生
    '開いているファイルの種類がHTMLなら処理を実行する

        If InStr(win.document.Title, "ログイン - Google アカウント") > 0 Then
            '開いているファイルの「タイトル」にYahooが含まれているなら
            Set objIE = win
            'このウインドウをobjIEとして指定する
            Exit For
        '処理を中断してFor~Nextを終了する
        End If
    End If

Next

Dim htmlDoc2 As HTMLDocument
Set htmlDoc2 = objIE.document

Debug.Print htmlDoc2.Title 'タイトル

実行時エラー　214767259（80004005）

'Document'メソッドは失敗しました。'IWeb Browser2'オブジェクト

但し、最初の何回かはうまくいってた??

行動規範の内容に同意します

回答1件

ベストアンサー

On Error Resume Next　を入れ、エラーを回避するよう修正してみました。

VBA
1For Each win In colSh.Windows
2    On Error Resume Next
3    If TypeName(win.document) <> "HTMLDocument" Then
4'    If TypeName(win.document) = "HTMLDocument" Then⇒ｴﾗｰ発生
5    Else
6    '開いているファイルの種類がHTMLなら処理を実行する
7
8        If InStr(win.document.Title, "ログイン - Google アカウント") > 0 Then
9            '開いているファイルの「タイトル」にYahooが含まれているなら
10            Set objIE = win
11            'このウインドウをobjIEとして指定する
12            Exit For
13        '処理を中断してFor~Nextを終了する
14        End If
15    End If
16    On Error GoTo 0
17Next