エクセルMSXML2で株価取得

質問

標題の件で、エクセルのマクロでMSXML2を用いて"株探"というサイトの"本日、年初来高値を更新した銘柄"の全ページのテーブル(stock_table)内の<td>の値をエクセルに取得したいのですが、エラーが解決できないのでどう直せばいいか困っています。

【参考サイト、備考】
エクセルの神様 > マクロVBA > マクロVBAサンプル集 > WEBデータの取得方法
http://excel-ubara.com/excelvba5/EXCELVBA222.html
のサイトのSample3(MSHTML.HTMLDocument)を参考にして書いたときは動作をしましたが複数ページ読み取る際にマクロがフリーズしてしまい、同サイトのSample4（MSXML2.XMLHTTP＋MSHTML.HTMLDocument）で書き直そうとして上手くいかず、エラーで止まってしまう状態です(オブジェクトの操作がよく分かってないです)

【プログラム】
' ' //
'スリープ設定

#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

'株探新高値1ページ目URL　https://kabutan.jp/warning/?mode=3_3&market=0&stc=&stm=0&page=1
'株探テーブルclass名：stock_table
'ＶＢＥにて参照設定(MSXML2.XMLHTTP):Microsoft XML, v3.0、Microsoft HTML Object Library

Sub kabutan_shintakane()

Dim i1 As Long 'エクセル現在入始行
Dim j1 As Long 'エクセル現在入力列
Dim i2 As Long 'テーブル行
Dim j2 As Long 'テーブル列
Dim Judge As Long '処理終了判定
Dim URLpage As Long 'URL現在ページ番号

Application.Cursor = xlWait 'カーソル砂時計

i1 = 2 'シート行開始位置
j1 = 3 'シート列開始位置
Judge = 10
URLpage = 1 'URL開始ページ番号

Do While Judge > 1

i2 = 0 '初期化
j2 = 0 '初期化
Dim objXML As New MSXML2.XMLHTTP
Dim htmlDoc As Object
Set htmlDoc = New MSHTML.HTMLDocument
Dim objTable As HTMLDocument 'HTMLテーブルオブジェク
Dim objITEM As Object 'HTMLセルオブジェクト

With objXML
.Open "GET", "https://kabutan.jp/warning/?mode=3_3&market=0&stc=&stm=0&page=" & URLpage, False 'URL入力
.send (Null)
htmlDoc.write .responseText
End With

Sleep (10)

Set objTable = htmlDoc.getElementsByClassName("stock_table")(0) '←型が合わなくてエラーになります

For Each objITEM In htmlDoc.getElementsByTagName("td")
Cells(i, j) = objITEM.innerText
j = j + 1
If j > 10 Then
j = 1
i = i + 1
End If
Next

i1 = i1 + objTable.Rows.Length - 1 '次のシート行位置
Judge = objTable.Rows.Length 'URL次ページ読み取るか判定
URLpage = URLpage + 1 '次のページ位置

Set objXML = Nothing '初期化
Set htmlDoc = Nothing '初期化
Set objTable = Nothing '初期化
Set objITEM = Nothing '初期化
Loop

Application.Cursor = xlDefault 'カーソル矢印

End Sub
' ' //

ご教授お願いいたします。

回答No.1

real beatin（@realbeatin） · ベストアンサー

こんにちは。

> Set objTable = htmlDoc.getElementsByClassName("stock_table")(0) '←型が合わなくてエラーになります
ソースは、xhtml ですので、この点私も不勉強でよく解らないのでが、
HTMLDocument.createDocumentFromUrl では読み込めても
（当方では↑動作確認出来ませんので、
　やはり不具合があってのトラブルだったのかも知れません？が）、
HTMLDocument.write では限定的になる（Classが拾えない）
ってことなのかな？と。
OKWAVEで回答されていらっしゃる方の中には、
私より遥かに詳しい方も居られますから、
詳しく知りたいようでしたら、やはり開発環境だけでも明かした方が
回答者の反応がよくなるとは思います。
でもまぁ、MSXML2.XMLHTTP＋MSHTML.HTMLDocument で処理する方が
HTMLDocument.createDocumentFromUrlよりは速いでしょうし、
却ってメンテは易しいとは思っています。
今回も直接の問題解決とは呼べないかも、ですが、
とりあえず、動くものを掲げてみますので、
これを叩き台にでもして、お望み通りに仕上げてみて下さい。
　変数 Judge,i1,j1,i2,j2 の扱い、
　次ページの出力先、
　テーブル上のコントロールや空セルも扱い、
等、ご要望が判らなかった部分は適当に書いています。

===
アクティブシートのＣ２を先頭に、
Ｃ：Ｏ列（Ｆ：Ｇ,Ｉ,Ｌ列は空）の範囲に、
順次した方向にレコードを伸ばすように出力します。
Judge には、指定した件数を超えたら処理終了
という意味を付けています。
i1,j1 シート行,列開始位置 → 固定値
i2 処理済レコード数
j2 テーブル上のカレント列Index
===

' ' //
Option Explicit

#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

'株探新高値1ページ目URL　https://kabutan.jp/warning/?mode=3_3&market=0&stc=&stm=0&page=1
'株探テーブルclass名：stock_table
'ＶＢＥにて参照設定(MSXML2.XMLHTTP):Microsoft XML, v3.0、Microsoft HTML Object Library

Sub kabutan_shintakane()

Dim i1 As Long 'エクセル初期入始行
Dim j1 As Long 'エクセル初期入力列
Dim i2 As Long '処理済レコード数
Dim j2 As Long 'テーブル上のカレント列Index
Dim Judge As Long '処理終了判定
Dim URLpage As Long 'URL現在ページ番号
Dim objXML As New MSXML2.XMLHTTP
Dim htmlDoc As Object
Dim objTable As MSHTML.HTMLTable 'HTMLテーブルオブジェクト
Dim objITEM As MSHTML.HTMLTableCell 'HTMLテーブルセルオブジェクト

　　Application.Cursor = xlWait 'カーソル砂時計

　　i1 = 2 'シート行開始位置 固定値
　　j1 = 3 'シート列開始位置 固定値

　　Cells(i1, j1).CurrentRegion.Offset(1).Clear

　　Judge = 64 '
　　URLpage = 1 'URL開始ページ番号

　　i2 = 0 '初期化
　　j2 = 0 '初期化

　　Do
　　　　Set htmlDoc = New MSHTML.HTMLDocument
　　　　With objXML
　　　　　　.Open "GET", "https://kabutan.jp/warning/?mode=3_3&market=0&stc=&stm=0&page=" & URLpage, False 'URL入力
　　　　　　.send (Null)
　　　　　　htmlDoc.write .responseText
　　　　End With

　　　　Sleep (10)

' ' tableタグを総当たりにして、クラス名がヒットしたら
' ' objTable に <table class="stock_table"> がセットされた状態でループを抜ける
　　　　For Each objTable In htmlDoc.getElementsByTagName("table")
　　　　　　If objTable.className = "stock_table" Then Exit For
　　　　Next

　　　　For Each objITEM In objTable.getElementsByTagName("td")
　　　　　　Cells(i1 + i2, j1 + j2) = objITEM.innerText
　　　　　　j2 = j2 + 1
　　　　　　If j2 >= 13 Then
　　　　　　　　j2 = 0
　　　　　　　　i2 = i2 + 1
　　　　　　End If
　　　　Next

'　　　　i1 = i1 + objTable.Rows.Length - 1 '次のシート行位置　？
'　　　　Judge = objTable.Rows.Length - 1 'URL次ページ読み取るか判定　？

　　　　URLpage = URLpage + 1 '次のページ位置

　　Loop While Judge > i2

'　　Set objITEM = Nothing '初期化　For Next を抜けた時にNothingですから不要です。
　　Set objTable = Nothing:　　Set htmlDoc = Nothing:　　Set objXML = Nothing '初期化

　　Application.Cursor = xlDefault 'カーソル矢印

End Sub

' ' //

お礼

度々ご回答をありがとうございます。
記載していただいたプログラムで正常に動くことを確認できました。
今回のMSXML2では止まることなく最後まで読み取れましたので、MSHTMLの場合は私のパソコンだと良くなかったのかもしれません。
開発環境はwindows10 Home、エクセル2010です(マクロを書くのはほぼ初心者であり、プログラムについての質問もあまりしたことがなかったため開発環境もどこまで伝えればいいか分かってないです)。
いろいろとアドバイスを本当にありがとうございました。