[[20190923214046]]　『ループ時に「オブジェクト変数または with ブロッ』（りくり）　ページの最後に飛ぶ

『ループ時に「オブジェクト変数または with ブロック変数が設定されていません。」というエラーが出てしまいます』（りくり）

こんにちは。
https://www.cosme.net/item/item_id/903/ranking/
のサイトから、ランキングの商品名、会社名、容量・価格、口コミ数を抽出するマクロを作っています。一度目は問題ないのですがループ時に「オブジェクト変数または with ブロック変数が設定されていません。」エラーが出てしまっており、原因が何か全く分かりません。なぜ1度目はOKで二度目にエラーが出てしまったのでしょうか？
そして、どのようにすれば改善できるでしょうか。

以下、わたしの書いたVBAです。

Sub ボタン1_Click()

Dim url As String
Dim http As Object
Dim WS As Worksheet
Dim check_row As Integer
Dim product_column As Integer
Dim price_column As Integer
Dim brand_column As Integer
Dim votes_column As Integer
Dim rank_column As Integer
Dim rank As Integer
Dim product As String
Dim brand As String
Dim price As String
Dim votes As String
Dim element As HTMLDDElement
Dim HtmlDoc As HTMLDocument
Dim HtmlBuf As Object

    Set WS = ActiveSheet       '   現在のシートを退避
    check_row = 7                   '   7行目から取得開始
    rank_column = 2                  '  順位の列
    product_column = 3               '　製品名の列
    brand_column = 4                 '  ブランド名の列
    price_column = 5                 '  価格の列
    votes_column = 6                 '  口コミ数の列
    rank = 0

    url = "https://www.cosme.net/item/item_id/903/ranking/"
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", url
    http.Send

    Do While WS.Cells(check_row, rank_column) <> ""
            Do While http.readyState < 4
                DoEvents
            Loop
        Set HtmlBuf = New HTMLDocument
        HtmlBuf.write http.responseText
        Set HtmlDoc = HtmlBuf
        Set element = HtmlDoc.getElementsByClassName("summary")(rank)
        product = element.getElementsByClassName("item")(rank).innerText '製品名
        brand = element.getElementsByClassName("brand")(rank).innerText '会社名
        price = element.getElementsByClassName("price")(rank).innerText '価格
        votes = element.getElementsByClassName("votes")(rank).innerText '口コミ数

        WS.Cells(check_row, product_column) = product
        WS.Cells(check_row, brand_column) = brand
        WS.Cells(check_row, price_column) = price
        WS.Cells(check_row, votes_column) = votes

Exist_out:

    check_row = check_row + 1
    rank = rank + 1
    product = ""
    brand = ""
    price = ""
    votes = ""
    Loop

End Sub

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

ちょっと私にはわからないので回答ではないですが、ステップ実行して【どの部分】でエラーが出るのか書き添えると、回答者側で状況が掴みやすくなって回答がたくさん付くかもしれません。

（もこな２） 2019/09/23(月) 22:05

[[20070219032632]] 『オブジェクト変数またはWithブロック変数が設定さ』（スフレ）　

おそらくこれと同じ現象ではないでしょうか。
（黄色い循環参照） 2019/09/23(月) 22:15

 １．ループさせる位置が少し変ですよ。

 　　＞Do While WS.Cells(check_row, rank_column) <> ""
 　　　　↑
 　　　その一文は、もっと下にある この一文の直前に移動する
 　　　　　　　　　　　　　　　　　↓
 　　　＞Set element = HtmlDoc.getElementsByClassName("summary")(rank)Set delement

 ２．配列の位置指定が変です。

     以下４行の rank を 0 に変更する。(まぁ複数あったら、いつも0でいい訳じゃないですけど、今回は1個しかないので）

 ＞  product = element.getElementsByClassName("item")(rank).innerText '製品名
 ＞  brand = element.getElementsByClassName("brand")(rank).innerText '会社名
 ＞  price = element.getElementsByClassName("price")(rank).innerText '価格
 ＞  votes = element.getElementsByClassName("votes")(rank).innerText '口コミ数

（半平太） 2019/09/23(月) 22:42

summaryクラスはrank数分存在していて、itemとかbrandというクラス名は、summaryクラスの子ですよね。 1つのsummaryには1つずつの子しかないのに、rank番目を見に行こうとするからエラーになってるのでしょう。

 Sub ボタン1_Click()
    Dim http As Object
    Dim WS As Worksheet
    Dim check_row As Integer
    Dim rank As Integer
    Dim element As HTMLDDElement
    Dim HtmlDoc As HTMLDocument
    Dim HtmlBuf As Object

    Set WS = ActiveSheet            '現在のシートを退避
    check_row = 7                   '7行目から取得開始
    rank = 0

    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://www.cosme.net/item/item_id/903/ranking/"
    http.Send

    Do While http.readyState < 4
        DoEvents
    Loop
    Set HtmlBuf = New HTMLDocument
    HtmlBuf.write http.responseText
    Set HtmlDoc = HtmlBuf

    For rank = 0 To HtmlDoc.getElementsByClassName("rank-num").Length - 1
        Set element = HtmlDoc.getElementsByClassName("summary")(rank)
        WS.Cells(check_row, 3) = element.getElementsByClassName("item")(0).innerText '製品名
        WS.Cells(check_row, 4) = element.getElementsByClassName("brand")(0).innerText '会社名
        WS.Cells(check_row, 5) = element.getElementsByClassName("price")(0).innerText '価格
        WS.Cells(check_row, 6) = element.getElementsByClassName("votes")(0).innerText '口コミ数
        check_row = check_row + 1
    Next rank
 End Sub
（???） 2019/09/24(火) 10:38

半平太様、
ご指摘いただきありがとうございます！
ただ、やはり修正しても
product = element.getElementsByClassName("item")(0).innerText
のところで同じエラーが発生してしまいます。
こちら1行ずつデバッグしたところではエラーは発生しないのですが、なぜかマクロを一気に作動させようとするときにのみエラーが出てしまいます。
もし何かしら対処法などあれば教えていただきたいです。

（りくり） 2019/09/24(火) 10:53

 ・・と言われましても、こちらではノントラブルなので、当方サイドでのトラブルシュートはかなり手間です。

 もう一つ回答案が出ていますので、そちらをお試しいただくのが先決です。(私は読んでいませんが）

 さて、今回も２回目(Rankが1）でトラブるのでしょうか？

 当初、1回目は「Rank」が同じ「0」なので、たまたま成功したという図式なんですけども。
 兎に角、１回目が成功したと言うことは、ページ読み込みミスは原因ではなかったハズです。

 もし今回から1回目もトラブったとすれば、原因が別ものになったと言うことになります。
 　通常は「ページ読み込みミス」が疑われます。
 　あと、URLを変更したなんてことは無いですね？(それだと話は全然別になります）

（半平太） 2019/09/24(火) 14:02

コメント返信：

[ 一覧(最新更新順) ]

[[20190923214046]] 『ループ時に「オブジェクト変数または with ブロッ』（りくり） ページの最後に飛ぶ

[[20190923214046]]　『ループ時に「オブジェクト変数または with ブロッ』（りくり）　ページの最後に飛ぶ