VBA Image from HTML

[jamescooper]

Using the following URL in cell S2: https://www.tesco.com/groceries/en-GB/shop/fresh-food/fresh-fruit/bananas

I am trying to pull all the image Src URL's on the page.

Any ideas why this isn't quite correct please?

Thanks.

Sub Images()


Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim LastRow As Long
Dim Images As MSHTML.HTMLImgCollection
Dim Image As MSHTML.HTMLImg
Dim arrItems_1 As Variant
Dim StrURL As String
Dim rngURL As Range


'Create URL and sent request
For Each rngURL In Worksheets("Sheet1").Range("S2", Worksheets("Sheet1").Range("S" & Rows.Count).End(xlUp))
    XMLPage.Open "GET", rngURL, False
    XMLPage.send
    DoEvents
    
    'Get the source (code) of the webpage
    HTMLDoc.body.innerHTML = XMLPage.responseText
    
    LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    Set Images = HTMLDoc.getElementsByClassName("product-list-container")(0).getElementsByTagName("img")
    
    For Each Image In Images
    If Image.className = "product-image" Then
    StrURL = StrURL & "|" & "https://img.tesco.com/" & Image.src
        End If
    
Next


Next
    'Store all results in an Array


    arrItems_1 = Split(Mid(StrURL, 2), "|")
    
    'Insert the results directly into Sheet1


    Sheets("Sheet1").Cells(LastRow, 1).Resize(UBound(arrItems_1) + 1) = Application.Transpose(arrItems_1)
    
End Sub

 

[Kyle123]

You just need to parse them out of the source, something like this should suffice. It's a bit fragile, but hey, you're webscraping, it's all fragile!

   Dim imgs
    Dim x As Long
    
    Const searchString As String = "https://img.tesco.com/"
    
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "https://www.tesco.com/groceries/en-GB/shop/fresh-food/fresh-fruit/bananas", False
        .send
        imgs = Split(.responsetext, searchString)
        For x = LBound(imgs) + 1 To UBound(imgs)
            Debug.Print searchString & Split(imgs(x), "&")(0)
        Next x
    End With

 

[jamescooper]

You just need to parse them out of the source, something like this should suffice. It's a bit fragile, but hey, you're webscraping, it's all fragile!

   Dim imgs
    Dim x As Long
    
    Const searchString As String = "https://img.tesco.com/"
    
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "https://www.tesco.com/groceries/en-GB/shop/fresh-food/fresh-fruit/bananas", False
        .send
        imgs = Split(.responsetext, searchString)
        For x = LBound(imgs) + 1 To UBound(imgs)
            Debug.Print searchString & Split(imgs(x), "&")(0)
        Next x
    End With

Thank you Kyle123, so with a loop to insert into the sheet the code I now have is:

Sub Images()


Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim imgs As Variant
Dim x As Long
Dim NextRow As Long
Dim LastRow As Long
Dim URL As Variant


'Create URL and sent request
    Const searchString As String = "https://img.tesco.com/"


    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "https://www.tesco.com/groceries/en-GB/shop/fresh-food/fresh-fruit/bananas", False
        .send
        imgs = Split(.responseText, searchString)
        For x = LBound(imgs) + 1 To UBound(imgs)
    NextRow = Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NextRow) = searchString & Split(imgs(x), "&")(0)
        Next x
    End With


LastRow = Range("A" & Rows.Count).End(xlUp).Row


rng = Range("A2:A" & LastRow)


For Each URL In rng


ActiveSheet.Pictures.Insert (URL)


Next URL
    
End Sub