Impor data web dengan Excel VBA

Question

Saya ingin ketika saya mengimpor URL situs web suatu produk, itu akan menunjukkan nama, deskripsi, harga, dan URL gambar produk ke dalam spreadsheet.

Inilah yang saya miliki: (bukan situs web asli)

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

Informasi tambahan
Nama produk: The Resistance: Avalon Social Deduction Gam
id = "productTitle" class = "a-size-large product-title-word-break"

Deskripsi produk: The Resistance: Avalon adalah game mandiri dan sementara The Resistance tidak diperlukan untuk bermain; game-game tersebut kompatibel dan dapat digabungkan
Untuk 5 hingga 10 pemain
Membutuhkan waktu bermain 30 menit
(All in class = "a-list-item" tetapi bagian yang berbeda)

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

URL Gambar: https://images-na.ssl-images-amazon.com/images/I/91JhcC33dTL._AC_SY879_.jpg
img alt = "Perlawanan: Game Deduksi Sosial Avalon"

Answer 1

Anda dapat menggunakan xhr sebagai pengganti IE untuk mengambil bidang yang disebutkan di atas. Ini pasti akan membuat eksekusi lebih cepat dan menghemat banyak waktu. Saya menggunakan regex hanya untuk mengisolasi tautan gambar yang diinginkan. Pastikan untuk menambahkan Microsoft HTML Object Libraryke perpustakaan referensi sebelum eksekusi.

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