VBAを使って、web上から数値を引っ張りたい

Question

初めてVBAを使って、IEからデータを引っ張りたいと思ったのですが、出来なくなってしまいました。

参考にしたサイトは
https://tonari-it.com/vba-ie-list/
です

商品の価格調査を行っておりまして、それをVBAを使って自動化したいと考えております。

やりたいこと
・A1セルにある商品名を、サイトで検索し、出てきたページに記載ある数値をB1セルに入力。

下記のコードを実行すると、エラーは起きないのですが、数値も入力されませんでした。

Sub 完成版()
    
    Dim ieApp As Internetexplorer
    Set ieApp = New Internetexplorer
    ieApp.Visible = True
    ieApp.Navigate "検索するサイトのURL"
        
        Do While ieApp.Busy = True Or ieApp.ReadyState < READYSTATE_COMPLETE
        DoEvents
        Loop
   Dim doc As HTMLDocument
   Set doc = ieApp.Document
   
   Dim sbox As IHTMLElement
   Set sbox = doc.getElementsByName("商品名")(0)
    
    Dim tBox As IHTMLElement
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Dim sh As Worksheet
    Set sh = wb.ActiveSheet
    
    Set tBox = doc.getElementsByName("商品名")(0)
    tBox.Value = sh.Range("A１").Value
    
    Dim sButton As IHTMLElement
    Set sButton = doc.getElementsByName("searchbutton")(0)
    sButton.Click
    
    Cells("1,2").Value = doc.getElementsByClassName("smaller")(0).innerText
    
End Sub

読みづらい点も多々あるかと思いますが、
ご教授お願い致します。

追記

念のため、<smaller>の中の56125が引っ張りたい数値です

追記

確認したところ、A1セルを入力する前のページにもsmallerがありました

Comments

[radames1000]

L1にも何も入力されていませんか？

[hatena19]

> 出来なくなってしまいました。
ということは以前はできていたということですか。
その時のコードは提示のコードと同じものですか。

[junkij]

radames1000さん
ありがとうございます。

... more
と表示されました

[junkij]

hatena19さん
ありがとうございます

誤解のある表現で申し訳ございません
以前出来ていたわけではなく
今回初めて作成し、初めて出たエラーです。

[radames1000]

Cells("1,2")だとL1が指定されています。B1だとCells(1,2)です。

[hatena19]

Set tBox = doc.getElementsByName("商品名")(0)
tBox.Value = sh.Range("A１").Value
の部分ですが、目的のテキストボックスにA１の値がちゃんと入力されていますか。
ステップ実行で確認してみてください。

https://www.excelspeedup.com/vbadebug/

[hatena19]

Cells("1,2").Value の部分は間違いですね。
Cells(1, 2).Value が正解です。

[junkij]

初歩的な事で失礼いたしました。
B1には表示されましたが

「... more」はA1セルの値を入力する前のサイト上にある値のようです

[junkij]

hatena19さん
ありがとうございます

Set tBox = doc.getElementsByName("商品名")(0)
tBox.Value = sh.Range("A１").Value
の部分ですが、目的のテキストボックスにA１の値がちゃんと入力されていますか。

こちらはテキストボックスにA1セルの値が入力されていました

[hatena19]

sButton.Click（検索ボタンクリック）で検索結果が表示されるまで時間がかかると思いますので、少し待機するようにするいいかと思います。

[junkij]

hatena19さん
ありがとうございます
sButton.Clickのしたに

Do While ieApp.Busy = True Or ieApp.ReadyState < READYSTATE_COMPLETE
DoEvents
Loop

を入れてみましたが、結果は変わりませんでした
検索後のページはieAppではなく、べつで指定する必要があるのでしょうか？

[hatena19]

実際のURLの提示がないので、そのページがどのような動作をするのか確認できませんので、あくまで推測ですが、検索ボタンクリックで別URLへ移動しているのでしょうか。移動せずに同じURLのままなら、回答の方法を試してみてください。

Answer 1

sButton.Click（検索ボタンクリック）で検索結果が表示されるまで時間がかかると思いますので、少し待機するようにするいいかと思います。

例えば下記のような感じで。

    sButton.Click

    Dim res As String
    res = doc.getElementsByClassName("smaller")(0).innerText
    For i = 1 tp 50
        If Not res Like "*more*" Then Exit For
        DoEvents
        Sleep 200 '0.2秒待機
        res = doc.getElementsByClassName("smaller")(0).innerText
    Next
    If res Like "*more*" Then
        Msgbox "検索に失敗しました。しばらく待って再トライしてください。"
    Else
        Cells(1, 2).Value = res
    End If

モジュールの宣言部に下記のコードが必要です。

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

Comments

[junkij]

hatena19さん

できました！ありがとうございます！