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

  • 質問

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

    IE10だと正常に動きます。
    IE11だと基本的にanchor.Clickのところでエラーが出ます。
    (※32bitのPCだと型を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
    2016年5月15日 3:01

すべての返信

  • 以前の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!)

    2016年5月15日 14:51
  • ご回答ありがとうございます。

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

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

    混乱しています。


    2016年5月21日 3:48