使用VBA的零售网站进行网页抓取

Question

我有一个相当有效的代码，但是我想修改代码。这个想法是去一个网站，输入商品并把价格卖给Excel。但是我只能硬编码它。我希望VBA一次处理50个项目，然后一键将项目的价格提取到excel中，这样它就可以选择每个单元格项目并搜索网站并粘贴到excel中，然后对50至100个项目进行处理。浏览完网站后，代码应从列中选择每个项目并在网上搜索并提取价格，然后粘贴到相应的项目中。

我尝试对列的项目使用for循环。我严重陷入循环.....;）

Sub webextract()
    Dim ie As SHDocVw.InternetExplorer        
    Set ie = New SHDocVw.InternetExplorer

    Dim HTMLdoc As MSHTML.HTMLDocument        
    Dim HTMLinput As MSHTML.IHTMLElement        
    Dim HTMLbuttons As MSHTML.IHTMLElementCollection        
    Dim HTMLbutton As MSHTML.IHTMLElement        
    Dim HTMLprice As MSHTML.IHTMLElementCollection

    Application.ScreenUpdating = False

    'searchterm = InputBox("ENTER TIM'S SEARCH TERM")        
    searchterm = Worksheets("AAP").Range("A9").Value
    ie.Visible = True
    ie.navigate "Enter the Web address"

    Do While ie.readyState <> READYSTATE_COMPLETE 
        Application.Wait Now + TimeValue("00:00:01")
        DoEvents
    Loop

    Set HTMLdoc = ie.document
    Set HTMLinput = HTMLdoc.getElementById("aap-960-search-input")
    HTMLinput.Value = searchterm

    Set HTMLbuttons = HTMLdoc.getElementsByClassName("icons8-search")
    HTMLbuttons.Item.Click

    'code to extract the price and put in the excel sheet
    'Set HTMLprice = HTMLdoc.getElementsByClassName("aap-pla-productprice__price red-price")

    Do While ie.readyState <> READYSTATE_COMPLETE        
        Application.Wait Now + TimeValue("00:00:01")
        DoEvents
    Loop

    Do While ie.readyState <> READYSTATE_COMPLETE
        Application.Wait Now + TimeValue("00:00:01")
        DoEvents
    Loop

    Do While ie.readyState <> READYSTATE_COMPLETE
        Application.Wait Now + TimeValue("00:00:01")
        DoEvents
    Loop

    'On Error GoTo Errorhandler        
    Dim htmlEle1 As IHTMLElement
    Set dat = ie.document.getElementsByClassName("aap-pla-productprice__price red-price")

    Do While ie.readyState <> READYSTATE_COMPLETE
        Application.Wait Now + TimeValue("00:00:01")
        DoEvents
    Loop

    For Each elm In dat
        If elm.innerText <> "" Then
            'Debug.Print elm.innerText
             Worksheets("AAP").Range("C9").Value = elm.innerText
        End If
    Next

    Do While ie.readyState <> READYSTATE_COMPLETE
        Application.Wait Now + TimeValue("00:00:01")
        DoEvents
    Loop

    Application.ScreenUpdating = True
    Set ie = Nothing
End Sub