質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.69%

VBAにてウェブサイトのテーブルの内容を取得したい

受付中

回答 1

投稿 編集

  • 評価
  • クリップ 1
  • VIEW 520

unotalk

score 118

VBAで当ECサイトの商品の情報を取得したいと思っています。
商品はhttps://example.com?id=1のようにidで管理されています。
ただし、販売中止などにより中には404ページになるidも含まれております。

商品の情報はtableタグ内に存在しており、th,tdタグ内の情報をエクセルに移したいと考えています。

そこで以下のようにVBAを作成したのですが、1つ目の商品の処理が終わるとIEが「動作を停止しました」というエラーがでて2つ目以降の商品情報をとることができません。
デバックすると
objIE.navigate "http://example.com?id=" & j
の箇所が黄色くなっています。

商品数はとりあえず5としています。

初歩的なところで間違えているかもしれませんが、あれこれ試しても一向に解決しないため質問させていただきました。
お手数ですがどなたかご回答いただけますでしょうか。

Sub product()
    Dim i As Long
    Dim j As Long

    Dim objITEM As Object
    Dim objIE As New InternetExplorer
    objIE.Visible = True

    For j = 1 To 5
        objIE.navigate "http://example.com?id=" & j
        Call untilReady(objIE)

        Range("A1").CurrentRegion.Offset(1, 0).ClearContents
        i = 2
        For Each objITEM In objIE.document.querySelectorAll("th, td")
            Cells(i, j) = objITEM.innerText
                i = i + 1
        Next
    Next
    objIE.Quit
    Set objITEM = Nothing
    Set objIE = Nothing
End Sub

Sub untilReady(objIE As Object, Optional ByVal WaitTime As Integer = 10)
    Dim starttime As Date
    starttime = Now()
    Do While objIE.Busy = True Or objIE.readyState <> READYSTATE_COMPLETE
        DoEvents
        If Now() > DateAdd("S", WaitTime, starttime) Then
            Exit Do
        End If
    Loop
    DoEvents
End Sub

試したこと
1.WaitTimeを10から1000に変更→結果、変化なし

Sub untilReady(objIE As Object, Optional ByVal WaitTime As Integer = 1000)

2.UntilReadyを削除し、Sleepを使用→結果、変化なし

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

Sub maker()
    Dim i As Long
    Dim j As Long

    Dim objITEM As Object
    Dim objIE As New InternetExplorer
    objIE.Visible = True

    For j = 1 To 5
        objIE.navigate "http://example.com?id=" & j
        Sleep 1000
        Range("A1").CurrentRegion.Offset(1, 0).ClearContents
        i = 2
        For Each objITEM In objIE.document.querySelectorAll("th, td")
            Cells(i, j) = objITEM.innerText
                i = i + 1
        Next
    Next
    objIE.Quit
    Set objITEM = Nothing
    Set objIE = Nothing
End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • m.ts10806

    2019/02/22 10:16

    多重起動の線が怪しそうです。
    forで回さず、1つだけだとどうでしょうか。

    キャンセル

  • m.ts10806

    2019/02/22 10:17

    あとはSleepを試してみてください。

    キャンセル

  • unotalk

    2019/02/25 18:22

    ありがとうございます。
    頂いたアドバイスを試してみました。
    ・1つめのforを削除して、j=1で固定してみましたが、以下の結果でした。
    結果:
    IEは問題が発生したため終了しました→プログラムの終了→このWebページに問題があるためIEのタブを開き直しました。
    ・Sleepの実行
    以下のコードを1行目に追記
    Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
    以下のコードをSleep 20000 と入れ替え
    Call untilReady(objIE)
    結果、上記と同じくIEの動作は停止しましたとなります。
    他に、untilReadyのwaitTimeを1000に変更しましたが、同じでした。。

    キャンセル

回答 1

0

untilReadyで完全に読み込みが終わっていないのに終了している可能性はないでしょうか?
(まだ途中なのにIEに次の要求が来てしまっておかしくなっている)
今の作りだとタイムアウトの10秒が過ぎると読み込みが終わっていなくても関数を抜けてしまうと思います。
試しにタイムアウトをなしにするか、時間を長く設定してみてはいかがでしょうか。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/25 18:41

    1000秒まで達しているのでしょうか?
    その前にループを抜けてますか?
    1000秒まで達しているなら更に伸ばしてみる必要はあるかと思いますし、達していないなら別の要因になるので、現象を切り分けるためにも確認してみてください。

    キャンセル

  • 2019/02/26 09:18

    1000秒まで達しているということはないと思います。1000秒たつ前にエラーが発生しているので。。

    キャンセル

  • 2019/02/26 09:18

    TanakaHiroakiさん
    ありがとうございます!試してみます。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.69%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる