Importa dati web con Excel VBA

Question

Desidero che quando importo l'URL di un sito Web di un prodotto, questo mostrerà il nome, la descrizione, il prezzo e l'URL dell'immagine del prodotto in un foglio di calcolo.

Ecco cosa ho: (non il vero sito web)

Sub Trial() Dim ieObj As InternetExplorer Dim ht As HTMLDocument
    
    Website = "https://www.amazon.com/resistencia-Avalon-cartas-empaque-original/dp/B009SAAV0C?pf_rd_r=WWESR922Z214Y10K3PHH&pf_rd_p=4dd821c0-e689-433a-a035-5e03461484eb&pd_rd_r=305599f9-5f3f-41c6-9a13-8daefd8d998c&pd_rd_w=qWHso&pd_rd_wg=BNzqC&ref_=pd_gw_unk"
    
    Set ieObj = New InternetExplorer ieObj.Visible = True ieObj.navigate Website
    
    Do Until ieObj.readyState = READYSTATE_COMPLETE DoEvents Loop
    
    Set ht = ieObj.document
    
End Sub

Informazioni aggiuntive
Nome del prodotto: The Resistance: Avalon Social Deduction Gam
id="productTitle" class="a-size-large product-title-word-break"

Descrizione del prodotto: The Resistance: Avalon è un gioco autonomo e mentre The Resistance non è obbligato a giocare; i giochi sono compatibili e possono essere combinati
Da 5 a 10 giocatori
Richiede 30 minuti di riproduzione
(Tutti in classe = "elemento-elenco" ma sezioni diverse)

Prezzo: $ 17,12
id="priceblock_ourprice"
class="a-size-medium a-color-price priceBlockBuyingPriceString"

URL dell'immagine:https://images-na.ssl-images-amazon.com/images/I/91JhcC33dTL._AC_SY879_.jpg
img alt="The Resistance: gioco di deduzione sociale di Avalon"

Answer 1

Puoi usare xhr invece di IE per recuperare i suddetti campi. Renderà sicuramente l'esecuzione più veloce e ti farà risparmiare un sacco di tempo. Ho usato regex solo per isolare il collegamento dell'immagine desiderato. Assicurati di aggiungere Microsoft HTML Object Libraryalla libreria di riferimento prima dell'esecuzione.

Sub GetContent()
    Const URL = "https://www.amazon.com/resistencia-Avalon-cartas-empaque-original/dp/B009SAAV0C?pf_rd_r=WWESR922Z214Y10K3PHH&pf_rd_p=4dd821c0-e689-433a-a035-5e03461484eb&pd_rd_r=305599f9-5f3f-41c6-9a13-8daefd8d998c&pd_rd_w=qWHso&pd_rd_wg=BNzqC&ref_=pd_gw_unk"
    Dim S$, sImage$, Matches As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:79.0) Gecko/20100101 Firefox/79.0"
        .send
        S = .responseText
    End With
    
    With New HTMLDocument
        .body.innerHTML = S
        [A1] = .querySelector("h1#title > span#productTitle").innerText
        [B1] = Trim(Split(.querySelector("#feature-bullets > ul.a-unordered-list").innerText, "model number.")(1))
        [C1] = .querySelector("span[id='priceblock_ourprice']").innerText
        sImage = .querySelector("#imgTagWrapperId > img").getAttribute("data-a-dynamic-image")
    End With
    
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = False
        .Pattern = """(.*?)"""
        .MultiLine = True
        Set Matches = .Execute(sImage)
        [D1] = Matches(2).submatches(0)
    End With
End Sub