none
Access2019のVBAで、InternetExplorerを日本証券取引所TDNetで自動巡回させることを考えていますが、セレクトボックスがうまく操作できません。 RRS feed

  • 質問

  • いつもお世話になっております。

    題名のとおり、Access2019のVBAでInternetExplorerを日本証券取引所TDnetで自動巡回を考えていますが、セレクトボックスの操作がうまくいかず、大変困っています。

    プログラムがエラーを起こしている部分を抜粋します。

    Dim sel As HTMLSelectElement
    Set sel = ie2.Document.getElementById("day-selector")    
    sel.selectedIndex = 2
    sel.FireEvent ("onchange")

    • selectedIndex = 2により、セレクトボックス"day-selector"には任意の日付(ここでは2019/11/16)が入り、
    • FireEvent("onchange")で、画面に任意の日付(2019/11/16)の適時開示情報の一覧が表示されるようになっています。

    僕は、こうして表示された適時開示情報をAccessのDBに取り込みたいと考えています。しかし、

    1. 肝心のInternetExplorerのDocument型は、ウォッチウインドウで調べてみると、なぜかFireEvent("onchange")が実行される前の状態のままであるため、任意の日付の適時開示情報を取得することができません。
      InternetExplorerの画面表示は、任意の日付の適時開示情報が正しく表示されているのにも関わらず、です。
      わけがわかりません。
    2. 画面の再読み込みをしたらDocument型が更新されるのではないかと考え、InternetExplorerのRefleshを実行してみましたが、これだと、せっかく任意の日付に更新されたInternetExplorerの画面がFireEvent("onchange")が実行される前の状態に戻ってしまいます。

    どのようにしたら、任意の日付に更新した後の適時開示情報の一覧を取得できるでしょうか?

    どうか、皆さんのお知恵をお貸しください。


    2019年11月16日 19:05

回答

  • Sub Test()
        Dim ie As InternetExplorer
        Set ie = CreateObject("InternetExplorer.Application")
        ie.Visible = True
        ie.navigate "https://www.release.tdnet.info/inbs/I_main_00.html"
        Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
            DoEvents
        Loop
        
        Dim doc As MSHTML.HTMLDocument
        Set doc = ie.document
        
        Dim frame As MSHTML.HTMLFrameElement
        Set frame = doc.getElementById("main_list")
        
        Dim cmb As MSHTML.HTMLSelectElement
        Set cmb = doc.getElementById("day-selector")
            
        For i = 0 To cmb.Length Step 1
            cmb.selectedIndex = i
            cmb.FireEvent ("onChange") 
            
            Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
                DoEvents
            Loop
     
            Dim listdoc As MSHTML.HTMLDocument
            Set listdoc = frame.contentDocument 'これ
            If Not (listdoc Is Nothing) Then
                Debug.Print listdoc.Url
            End If
            
            Dim time As Date
            time = DateAdd("s", 10, Now)
            Do While time > Now
                DoEvents
            Loop
        Next
    End Sub


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

    • 回答としてマーク ノラネコ 2019年11月17日 5:45
    2019年11月17日 2:38

すべての返信

  • Sub Test()
        Dim ie As InternetExplorer
        Set ie = CreateObject("InternetExplorer.Application")
        ie.Visible = True
        ie.navigate "https://www.release.tdnet.info/inbs/I_main_00.html"
        Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
            DoEvents
        Loop
        
        Dim doc As MSHTML.HTMLDocument
        Set doc = ie.document
        
        Dim frame As MSHTML.HTMLFrameElement
        Set frame = doc.getElementById("main_list")
        
        Dim cmb As MSHTML.HTMLSelectElement
        Set cmb = doc.getElementById("day-selector")
            
        For i = 0 To cmb.Length Step 1
            cmb.selectedIndex = i
            cmb.FireEvent ("onChange") 
            
            Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
                DoEvents
            Loop
     
            Dim listdoc As MSHTML.HTMLDocument
            Set listdoc = frame.contentDocument 'これ
            If Not (listdoc Is Nothing) Then
                Debug.Print listdoc.Url
            End If
            
            Dim time As Date
            time = DateAdd("s", 10, Now)
            Do While time > Now
                DoEvents
            Loop
        Next
    End Sub


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

    • 回答としてマーク ノラネコ 2019年11月17日 5:45
    2019年11月17日 2:38
  • こんにちは、gekkaさん。

    すばらしいサンプルプログラムをどうもありがとうございました!

    おかげで疑問は完璧に氷解しました!

    ネットで一生懸命containDocumentのようなメソッドを探していましたが、全く見つからず困り果てておりました。

    これでプログラム作業に戻ることができます。

    重ねてお礼申し上げます。

    どうもありがとうございました。

    2019年11月17日 5:45