Nhập dữ liệu web với Excel VBA

Question

Tôi muốn khi tôi nhập URL trang web của một sản phẩm, nó sẽ hiển thị URL tên, mô tả, giá và hình ảnh của sản phẩm đó vào một bảng tính.

Đây là những gì tôi có: (không phải trang web thật)

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

Thông tin bổ sung
Tên sản phẩm: Mức kháng cự: Mức khấu trừ trên mạng xã hội Avalon Gam
id = "productTitle" class = "a-size-large product-title-word-break"

Mô tả sản phẩm: The Resistance: Avalon là một trò chơi độc lập và trong khi The Resistance không bắt buộc phải chơi; các trò chơi tương thích và có thể được kết hợp
Cho 5 đến 10 người
chơi Thời gian chơi 30 phút
(Tất cả trong class = "a-list-item" nhưng các phần khác nhau)

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

URL hình ảnh: https://images-na.ssl-images-amazon.com/images/I/91JhcC33dTL._AC_SY879_.jpg
img alt = "Cuộc kháng chiến: Trò chơi khấu trừ xã ​​hội Avalon"

Answer 1

Bạn có thể sử dụng xhr thay vì IE để tìm nạp các trường nói trên. Nó chắc chắn sẽ làm cho việc thực hiện nhanh hơn và tiết kiệm rất nhiều thời gian cho bạn. Tôi chỉ sử dụng regex để cô lập liên kết hình ảnh mong muốn. Đảm bảo thêm Microsoft HTML Object Libraryvào thư viện tham chiếu trước khi thực thi.

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