[[20180619011814]]　『IE制御で画面遷移のイベント待受けについて』（かず）　ページの最後に飛ぶ

『IE制御で画面遷移のイベント待受けについて』（かず）

IE制御で画面遷移のイベント待受けについて

VBAでWebページの読み込み完了をCOMイベント
で取得しようとしています。
Webページ「IE で，フレームのある WEB ページの読み込み完了
まで待機する方法」
http://www5f.biglobe.ne.jp/~f-lap/tips_wait_documentcomplete.html
を参考にさせて頂いて、フレームのあるページでもフレームのないページでも
同じような扱いでページの状態遷移を待ち受けができるよう(注　一部のコードを32ビット版動作に割り切って修正）になりました。
(クラスモジュール　CIEWaitを参照ください）

そこで、実際に会社のイントラページ(フレームあり)でCIEWaitで
待受けさせると、待受け前にすでにページを表示し終わっていて、待ち受
けの時点ですでにDocumentCompleteが終わっているように見えるます。
待受けの制御ができたと思ったら、待受け前の段階でドキュメントを
捕まえられないという事態で対応に悩んでいます。
後述のsheet1モジュールを参照)

以下の詳細(1)～(7)に現状と(8)～(10)推定原因と確認方法を記載しました
IE制御に経験のある方にぜひアドバイスを頂きたいと思います。
どうぞよろしくお願いいたします。

詳細
(1)ページ社内のイントラページで、ログイン済み。
(2)WaitIEメソッドでフレーム有、フレーム無のページで
待受けはできるようになった。　URL(a)(b)(ｃ)は問題なし
(3)(A)Navigate直後には　.visibleをTrueにしていないので
　　通常ページは表示されないはず（あまり自信なし）
(4)実際の動作では(A)Navigate直後に画面は表示されている→リロードなのでは？
　
(5）waitIE に入っても DocumentCompleteイベントが発生せず　タイムアウトする
　 →すでに読込完了しているので、待受け対象のイベントが発生していない
(6)（A)直後の(C)では実行時エラー'-2147023706　が発生する
(7）VBEで（D)をブレークポイントにして確認　docはnothingになっている
　 →　現状理由不明

(8) 推定原因　oobjIE.Visible を実行していないのにページが
　　表示されているということは、Webページを「リロード」しているのではないか。
　　リロードならページの画面完了はDocumentCompleteではなくDownloadComplete
　　になるので今のWaitIEメソッドではこのDownloadCompleteではずっとループする
　　のは当然。しかしURL(a)(b)では、(C)の所でdocを正しく取得できている
　　
(9) 確認方法　　会社のページ(d)と他のページで何が違うのか F12ツールで
　　objIEの.ReadyStateプロパティでどんなイベントが発生しているか調べる。

　　[ツール]　IE コンポーネントにおけるイベントの発生順序
　　http://d.hatena.ne.jp/dayflower/20070926/1190787926

　　→ネットワークやUIでイベントの詳細がわかるのでしょうか
　　URL(d)をNavigateした際に　画面上半分にIE、下半分にF12ツールでイベント発生順
　　をモニターできれば確かに状況が明確かもしれない
　　　　　
(10)推定原因２
　　Excel VBAでIE操作時にオートメーションエラーが出た時は、対象のURLが
　　「信頼済みサイト」に登録されているからかもしれない
　　https://qiita.com/3mc/items/da045e86d25ef697ec43
　　(C)の所でエラーになるのがイントラサイトの場合だけなので、確かに
　　InternetExplorerMediumを使うことで対応できるのかもそれない　

'--------
'sheet1 モジュール　
'--------
Option Explicit

Dim doc As HTMLDocument
Dim m_isRunning As Boolean

Private Sub CommandButton1_Click()

    If m_isRunning Then Exit Sub
    m_isRunning = True

    Dim objIE As SHDocVw.InternetExplorer
    Set objIE = New SHDocVw.InternetExplorer

    Dim ieWait As CIEWait
    Set ieWait = New CIEWait
    Set ieWait.ie = objIE

    ieWait.frame = True

    '○問題なし　objIE.navigate "http://www5f.biglobe.ne.jp/~f-lap/index.htm"         '（a) フレームあり    
    '○問題なし　objIE.navigate "https://dev.to/"         ' （b)フレームあり 表示が非常に早いWebページ
    '○問題なし　objIE.navigate "http://www.t3.rim.or.jp/~buchi/procobol/sld024.htm" ' (c)フレームなし

　 '×問題あり　
　　objIE.navigate "https:// 会社のページ/"　　　’★（A）フレームあり　URL(d)

    On Error Resume Next
    Set doc = objIE.document　　　　’★（C）
    On Error GoTo 0　　　　　　　　　  ' ★（D）

    If Err.Number <> 0 Then
        If Not ieWait.WaitIE(5000, False) Then  ’★（B）
            MsgBox "IEのDocumentCompleteの待機に失敗。"
            m_isRunning = False
            Exit Sub
        End If
    End If

    Debug.Print "After ieWait.WaitIE()"

    If Not objIE.Visible Then
        objIE.Visible = True
    End If

    m_isRunning = False

End Sub

'ＩＥを削除された場合にオブジェクトを開放する
'これがないと「Excelを終了できません」となる

Private Sub objIE_OnQuit()

    Set objIE = Nothing    '握っていた IE への参照を解放しておきます。
End Sub

’--------
'クラスモジュール　CIEWait
' 出典 IE で，フレームのある WEB ページの読み込み完了まで待機する方法
' http://www5f.biglobe.ne.jp/~f-lap/tips_wait_documentcomplete.html
’LongPtr → Longに変更
'--------
Option Explicit

Private Const MWMO_WAITALL As Long = &H1
Private Const MWMO_ALERTABLE As Long = &H2
Private Const MWMO_INPUTAVAILABLE As Long = &H4

' Ｑ１　クラス化するとなぜ　MsgWaitForMultipleObjects を
' MsgWaitForMultipleObjectsExにするのか不明

Private Declare _
Function MsgWaitForMultipleObjectsEx Lib "user32.dll" ( _

    ByVal nCount As Long, _
    ByRef pHandles As Long, _
    ByVal dwMilliseconds As Long, _
    ByVal dwWakeMask As Long, _
    ByVal dwFlags As Long _
) As Long ' 第２引数の型　LongPtr → Long

Private Const STATUS_WAIT_0 As Long = 0&
Private Const WAIT_OBJECT_0 As Long = (STATUS_WAIT_0) + 0&
Private Const QS_ALLINPUT As Long = &H4FF&

Private Const INFINITE As Long = &HFFFFFFFF ' Infinite timeout

Private Const WAIT_TIMEOUT As Long = 258&
Private Const STATUS_USER_APC As Long = &HC0&
Private Const WAIT_IO_COMPLETION As Long = STATUS_USER_APC
Private Const WAIT_FAILED As Long = &HFFFFFFFF

'Private Declare Function MsgWaitForMultipleObjects Lib "user32.dll" ( _
' ByVal nCount As Long, _
' ByRef pHandles As LongPtr, _
' ByVal fWaitAll As Long, _
' ByVal dwMilliseconds As Long, _
' ByVal dwWakeMask As Long _
') As Long

' VBA 32ビットと64ビットの違い
' https://www.saka-en.com/office/vba-32bit-64bit-declare-statement-branch/
'64Bit 版 Office では、32Bit 版に比べて使用できるメモリ容量が大きくなり、2GB
'を超えるサイズのファイルを扱うことができるようになりました。
'これに伴い、VBA も VBA7 (Microsoft Visual Basic for Applications 7.0) に
' バージョンアップされました。

'64Bit 版では、ポインターやハンドルのサイズが 32Bit 版に比べて大きくなったため
'、Long 型を使用すると予期しないエラーが発生する可能性があります。
'そのため、Office 2010 以降ではその問題に対応した新しいデータ型として、
'LongPtr 型(ポインターデータ型)と LongLong型(64Bit 数値型)が追加されています。

'64Bit 版では、Declare ステートメントを使って Windows API を呼び出す場合、これ
'まで使っていた Long 型を適切な形で置き換える必要があります。
'そうなると、32Bit 版なのか、64Bit 版なのかを判別する方法が必要になりますね。
'Office 2010 以降、VBA7 と Win64 という条件付きコンパイル定数が追加されました。

' 第２第４引数、戻り値の型　LongPtr → Long　に変更
Private Declare _
Function CreateEvent Lib "kernel32.dll" Alias "CreateEventW" ( _

    ByVal lpEventAttributes As Long, _
    ByVal bManualReset As Long, _
    ByVal bInitialState As Long, _
    ByVal lpName As Long _
) As Long

' 第１引数の型　LongPtr → Long　に変更
Private Declare _
Function SetEvent Lib "kernel32.dll" ( _

    ByVal hEvent As Long _
) As Long

' 第１引数の型　LongPtr → Long　に変更
Private Declare _
Function ResetEvent Lib "kernel32.dll" ( _

    ByVal hEvent As Long _
) As Long

' 第１引数の型　LongPtr → Long　に変更
Private Declare _
Function CloseHandle Lib "kernel32.dll" ( _

    ByVal hObject As Long _
) As Long

Dim m_hEvent As Long 'イベントハンドル用　型をLongPtr→Longに変更

Dim m_topFrame As Object '今回のトップレベルウィンドウ/フレーム

Dim WithEvents m_IE As SHDocVw.InternetExplorer

Dim frame_ As Boolean

Dim DocComplete_flg As Boolean

' 全入力のウィンドウメッセージを処理しつつ，
' 引数で渡されたイベントが発生するまで待機。
Private Function VBAWaitWithDoEvents( _

    Optional ByVal dwMilliseconds As Long = INFINITE) As Boolean

    ' 省略可能な引数の場合、オブジェクト型でない引数は
    ' = デフォルト　の形でデフォルト値を設定可能
    ' オブジェクト型の引数の場合はIf MISSING(obj) Then で判定

    Const nCount As Long = 1&

    Dim prevTime As Single
    '　Timer関数は単精度浮動小数点(single)を返す
    '  PrevTime Single
    '  dwMilliseconds タイムアウト時間

    If dwMilliseconds <> INFINITE Then
        prevTime = Timer()
    End If

    Do
        Dim rc As Long
        rc = MsgWaitForMultipleObjectsEx(nCount, _
                                         m_hEvent, _
                                         dwMilliseconds, _
                                         QS_ALLINPUT, _
                                         MWMO_ALERTABLE Or MWMO_INPUTAVAILABLE)
        If rc = WAIT_OBJECT_0 Then
            ' イベント発生。
            Debug.Print "WAIT_OBJECT_0"
            VBAWaitWithDoEvents = True
            Exit Function
        ElseIf rc = WAIT_OBJECT_0 + nCount Then
            ' メッセージキューに入力あり。
            Debug.Print "WAIT_OBJECT_0 + nCount"
            DoEvents
        ElseIf rc = WAIT_TIMEOUT Then
            ' タイムアウト
            Exit Function
        ElseIf rc = WAIT_IO_COMPLETION Then
            ' APC is queued.
            DoEvents
        ElseIf rc = WAIT_FAILED Then
            ' Failed.
            Exit Function
        Else
            ' One or more mutex objects were abandoned.
            DoEvents
        End If

        If dwMilliseconds <> INFINITE Then
            Dim currentTime As Single
            currentTime = Timer()
            If prevTime > currentTime Then
                ' 仕切り直しとする。
                prevTime = currentTime
            End If
            dwMilliseconds = dwMilliseconds - (currentTime - prevTime) * 1000
            If dwMilliseconds <= 0 Then Exit Do
            prevTime = currentTime
        End If
    Loop

End Function

Private Sub Class_Initialize()

    m_hEvent = CreateEvent(0, 0, 0, 0)
End Sub

Private Sub Class_Terminate()

    CloseHandle m_hEvent
End Sub

Private Sub m_IE_NavigateComplete2(ByVal pDisp As Object, URL As Variant)

    If frame_ = True And m_topFrame Is Nothing Then

        ' トップレベルの NavigateComplete2 イベントは最初に発生。
        Debug.Print "frame あり　NavigateComplete2"

        Set m_topFrame = pDisp

    End If

End Sub

Private Sub m_IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)

    If frame_ = True And pDisp Is m_topFrame Then

        Debug.Print "frame あり　m_IE_DocumentComplete"

        ' 関連フレームワーク群におけるトップレベルの DocumentComplete イベントは最後に発生

        SetEvent m_hEvent           ' Event オブジェクトを signaled 状態にする。
        Set m_topFrame = Nothing

    ElseIf frame_ = False Then

        Debug.Print "frame なし DocumentComplete"
        SetEvent m_hEvent       ' Event オブジェクトを signaled 状態にする。
        DocComplete_flg = True

    End If

End Sub

Public Property Set ie(ByVal ie As SHDocVw.InternetExplorer)

    Set m_IE = ie
End Property

Public Function WaitIE(Optional ByVal dwMilliseconds As Long = INFINITE, _

                       Optional ByVal Release As Boolean = False) As Boolean
    If m_IE Is Nothing Then
        MsgBox "想定外エラー　InternetExplorerオブジェクトが設定されていません。"
        Exit Function
    End If

    WaitIE = VBAWaitWithDoEvents(dwMilliseconds)

    If Release Then
        Set m_IE = Nothing
    End If
End Function

Private Sub m_IE_NewWindow2(ppDisp As Object, Cancel As Boolean)

    Set m_IE_NEW = New SHDocVw.InternetExplorer

    Set ppDisp = m_IE_NEW ' 作ったオブジェクトを代入

    Debug.Print "m_IE_NEW_NewWindow2"

    m_IE_NEW.Visible = True

End Sub

Private Sub m_IE_NEW_DocumentComplete(ByVal pDisp As Object, URL As Variant)

    If frame_ = True And pDisp Is m_topFrame Then

        Debug.Print "frame あり　m_IE_DocumentComplete"

        ' トップレベルの DocumentComplete イベントは最後に発生
        SetEvent m_hEvent           ' Event オブジェクトを signaled 状態にする。
        Set m_topFrame = Nothing

    ElseIf frame_ = False Then

        Debug.Print "frame なし DocumentComplete"
        SetEvent m_hEvent       ' Event オブジェクトを signaled 状態にする。
        DocComplete_flg = True

    End If

End Sub

Property Let frame(ByVal new_frame As Boolean)

    frame_ = new_frame
End Property

Property Get frame() As Boolean

    frame = frame_
End Property

'要否検討中
Property Get DocCmplt() As Boolean

    DocCmplt = DocComplete_flg
End Property

Private Sub m_IE_OnQuit()

    Set m_IE = Nothing
End Sub

＜使用 Excel：Excel2016、使用 OS：Windows7 ＞

Navigateした直後にobjIE.Documentを使おうとしているからでしょうね。 PC性能が高く、回線速度が速く、軽いページであれば、一瞬でNavigateが終わるので正常代入する事もあるでしょうけど、Navigateしてからページを読み込み終わるまで時間がかかります。なので、Navigate直後にieWaitしましょう。 docに代入するのは、ページ表示完了後です。（なお、ieWaitの元ページはフィルタされてしまって見られなかったので、中身は見ていませんが、名前からおそらくreadyStateとかBusyを調べているのだろうと推測しています）

また、従来の定番だったInternetExplorerですが、IEのデフォルトセキュリティが厳しくなったので、表示できない問題が出たときは、InternetExplorerMedium を試してみてください。
（???） 2018/06/19(火) 09:14

???さん

　コメント有難うございます。非常に有難いです。今回
　クラスモジュールのなかのウェイト処理の意味がなあかなか理解でき
　ませんでした。
　
　今回の件は、InternetExplorerMediumを使うことで解決できました
　navigateの直後にreadyStateを調べたところ　DocumentCompleteも
　帰ってきていました。
　(7)docがnothingになったのはアートメーションエラーが原因
　(8)リロードではありませんでした。objIE.visibleでないのに表示
　　されるはおそらく事実誤認でした。お恥ずかしい限りです。
　(9)F12ツールの使ったデバッグはまだ習得できていません。
　(10)これが原因　InternetExplorerMedium を使いました。
　
　＞名前からおそらくreadyStateとかBusyを調べているのだろうと推測

　この点は、ieWaitの元ページではreadyStateとかBusyは使ってないです。
　基本的に　DocumentComplete が来たら特定のイベントを発行
　それとは別に、MsgWaitForMultipleObjectsEx　と言う関数でイベントを
　他のイベントも含めて特定のイベントを待ち受けるという仕組みだと理解
　しています

　振り返りとして、以下の点はもっと調べたいと思っています。
　お気づきの点があればご指摘お願いいたします。

　Q1 まだHTMLのいろいろな機能に詳しくないのですがインライン
　　フレームiframe を使ったページも　フレームを使ったページ
　　と同じように扱えばいいんでしょうか？

　Q2 COMイベントでの待受けできない制約があるページには
　　例えばどんなページでしょうか。DOMやgetElementByTagNameなど
　　の関数で操作できななそうなのはどういうページなのでしょうか
　　
　以上
（かず） 2018/06/20(水) 01:30

フレームを扱う場合は、以下のように何番目のフレームかを指定して、同じように処理すれば良いでしょう。

    Set doc = objIE.Document.Frames(1).Document

なお、フレーム数は objIE.Document.Frames.Length で得られますが、対象となるURLのフレーム構成なんて事前に判っているでしょうし、決め打ちで良いと思います。

待ち受けできないページとは、通常は表示完了を先に書いたようなreadyStateとかBusyでチェックするのですが、ページが更にJS等で表示更新するような場合（google mapとか？）、これだと最初のページの完了で条件成立してしまうので、その後の表示更新完了を拾えないものの事かと思います。でも、今回かずさんはクラスモジュールでコールバックに対応しているので、m_IE_DocumentCompleteの中で、目的のURLにたどり着くまで完了イベントを読み捨てれば、どんなページでも完了検出できると思いますよ。
（???） 2018/06/20(水) 09:33

コメント返信：

[ 一覧(最新更新順) ]

[[20180619011814]] 『IE制御で画面遷移のイベント待受けについて』（かず） ページの最後に飛ぶ

[[20180619011814]]　『IE制御で画面遷移のイベント待受けについて』（かず）　ページの最後に飛ぶ