VBAからInternetExplorerを操作するとリンク先ページの操作ができない

Question

下記の参考プログラムのように
Navigateで開いたページ（トップページ）から
リンク先のページ（検索ページ）に移動しても
オブジェクト（ie）のHTMLの内容がトップページのままで
リンク先のページの内容にならず、処理がうまくいきません。

IE10だと正常に動きます。
IE11だと基本的にanchor.Clickのところでエラーが出ます。
（※32bitのＰＣだと型をObjectに変更すると動きます。64bitだと動きません。）

Excelは2007ですが2016でも同様の結果でした。


詳しい方、どうすれば64bit　IE11で動くようになるのかご享受ください。


#If VBA7 And Win64 Then
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub チェック()

　　Dim ie As InternetExplorer
　　Dim 検索窓 As HTMLInputElement
　　Dim anchor As HTMLAnchorElement
　　Dim Doc As HTMLDocument
　　

'IEを表示させる。----------------

　　Set ie = CreateObject("InternetExplorer.Application")
　　ie.Visible = True
　　ie.navigate "http://www.rasin.co.jp/"
　　
waitBrowsing ie '別途funtionを定義

Sleep 3000

'検索窓に個別コードを入力し検索ボタンをクリック。---------------

Worksheets("チェックリスト").Activate '「チェックリスト」という名前のシートにある商品を呼び出したい。

　　チェックリスト最下行番号 = Range("B100000").End(xlUp).Row
　　
K = 5

For K = 5 To チェックリスト最下行番号 '「チェックリスト」は5行目から始まっているため、5行目から最後までをループする。

Set 検索窓 = ie.document.getElementsByName("key").Item(0)
Set 検索ボタン = ie.document.getElementsByName("btn").Item(0)
個別コード = Worksheets("チェックリスト").Range("B" & K).Value

　　　　検索窓.Value = 個別コード
　　　　検索ボタン.Click


waitBrowsing ie
　　
　　　　　　Sleep 3000
　　　　　　
　　　　　　'検索結果画面に到着----------------------------
　　　　　　
　　　　If InStr(ie.document.body.innerText, "該当商品はありません") <> 0 Then '該当商品が無い場合
　　　　
　　　　'処理内容を記述
　　　　
　　　　Else '該当商品がある場合(例：006MHBAN0051)
　　　　
　　　　　　Set h2 = ie.document.getElementsByTagName("h2")(5)
　　　　　　Set anchor = h2.getElementsByTagName("A")(0)
　　　　　　anchor.Click '←ここでエラーが出ます。ローカルウィンドウを見るとh2には一つ前の画面(トップページ)のソースコードを読み込んでいます。なぜページ遷移後のソースコードを読み込まないのでしょうか。


waitBrowsing ie
　　
　　　　　　Sleep 3000


　　'商品ページに到着----------------------------

　　　　End If
　　
Next

ie.Quit


End Sub


Private Sub waitBrowsing(ie As InternetExplorer, Optional FindString As String = "")
　　Dim FoundPos As Long
　　Do While FoundPos = 0
　　　　Do While ie.Busy Or ie.readyState < READYSTATE_COMPLETE
　　　　　　DoEvents
　　　　Loop
　　　　FoundPos = 0
　　　　On Error Resume Next
　　　　FoundPos = InStr(ie.document.body.innerText, FindString)
　　　　On Error GoTo 0
　　　　DoEvents
　　Loop
End Sub

Answer 1

以前のIEとは異なり、IE11はBusyやReadyStateでの判定では読み込みの完了が待機できなくなっています。
ですから、その方法で判定しても読み込み完了前に次に進んでしまうため、実際には読み込み完了してからでないと存在しないリンクは見つからずにエラーになります。

イベントを使って読み込みの完了を判定する方法を使うとうまくいくかもしれません。

モジュールに以下のコード

#If VBA7 And Win64 Then
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub チェック()
    Dim IE As InternetExplorer
    Dim 検索窓 As HTMLInputElement
    Dim anchor As HTMLAnchorElement
    Dim Doc As HTMLDocument
    'IEを表示させる。----------------
    
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    
    Dim waiter As New IEWaiter
    Set waiter = New IEWaiter
    Set waiter.IE = IE
    
    waiter.State = 0 'ページ遷移前に状態をリセット
    IE.navigate "http://www.rasin.co.jp/"
    waiter.waitBrowsing 'ページ遷移が終わるのをイベントを使って待機
    'Sleep 3000

    '検索窓に個別コードを入力し検索ボタンをクリック。---------------
    Worksheets("チェックリスト").Activate 'チェックリスト」という名前のシートにある商品を呼び出したい。
    チェックリスト最下行番号 = Range("B100000").End(xlUp).Row
    K = 5
    For K = 5 To チェックリスト最下行番号 '「チェックリスト」は5行目から始まっているため、5行目から最後までをループする。
        Set 検索窓 = IE.document.getElementsByName("key").Item(0)
        Set 検索ボタン = IE.document.getElementsByName("btn").Item(0)
        個別コード = Worksheets("チェックリスト").Range("B" & K).value
        検索窓.value = 個別コード
        
        waiter.State = 0 'ページ遷移前に状態をリセット
        検索ボタン.Click
        waiter.waitBrowsing 'ページ遷移が終わるのをイベントを使って待機
        
        'Sleep 3000
        
        '検索結果画面に到着----------------------------
        If InStr(IE.document.body.innerText, "該当商品はありません") <> 0 Then '該当商品が無い場合
           '処理内容を記述
        Else '該当商品がある場合(例：006MHBAN0051)
            Set h2 = IE.document.getElementsByTagName("h2")(5)
            Set anchor = h2.getElementsByTagName("A")(0)
            
            waiter.State = 0 'ページ遷移前に状態をリセット
            anchor.Click
            waiter.waitBrowsing 'ページ遷移が終わるのをイベントを使って待機
            
            'Sleep 3000
            '商品ページに到着----------------------------
        End If
    Next
    
    IE.Quit
End Sub

IEWaiterとう名前のクラスモジュールを追加して以下のコード

'クラスファイルを作る。名前は適当にIEWaiterと名前を付ける
'Microsoft Internet Controlsの参照を追加すること
Option Explicit

Private WithEvents objIE As SHDocVw.InternetExplorer
Private m_State As Integer

'読み込み状態判定用のプロパティ
Public Property Get State() As Integer
    State = m_State
End Property
Public Property Let State(ByVal value As Integer)
    m_State = value
End Property

Public Property Get IE() As SHDocVw.InternetExplorer
    Set IE = objIE
End Property
Public Property Set IE(ByVal value As SHDocVw.InternetExplorer)
    Set objIE = value
End Property

Private Sub objIE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    '読み込みが完了したらイベントで呼ばれる
    m_State = m_State + 1
End Sub

Public Sub waitBrowsing(Optional FindString As String = "")
    Dim FoundPos As Long
    Do While FoundPos = 0
        Do While m_State = 0
            DoEvents
        Loop

        FoundPos = 0
        On Error Resume Next
        FoundPos = InStr(objIE.document.body.innerText, FindString)
        On Error GoTo 0
        DoEvents
    Loop
End Sub

---

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

Answer 2

ご回答ありがとうございます。

頂いたコードを実行してみたのですが、やはりエラーが出てしまいます。

ページ遷移が問題なのはわかったのですが、リストの1番目は正しく処理されるのに2番目はダメだったりで

混乱しています。