Excel webwcraping em excel para retornar nome e imagem

[Steaumpunk]

Olá pessoal, alguém poderia por gentileza me ajudar com um código VBA?

Eu quero a partir de uma lista de códigos de barras buscar pelo nome do produto e pelo link da imagem e tem que ser em Excel para que eu possa exportar a planilha para um site.

Na coluna A ficam os códigos de barras

Na coluna B retorna o nome do produto

Na coluna C retorna o link da imagem

 

Código de barras para teste

7898728324712

46798772408

52742567006

7898349700056

7896029077603

7791293999470

7896806700021  

 

O resultado que me retorna é

 

Sub GetProductInfo()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim http As Object
    Dim html As Object
    Dim barcode As String
    Dim productName As String
    Dim productImage As String
    Dim url As String

    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set http = CreateObject("MSXML2.XMLHTTP")
    Set html = CreateObject("HTMLFile")

    For i = 2 To lastRow
        barcode = ws.Cells(i, 1).Value
        url = "https://api.cosmos.bluesoft.com.br/produtos/" & barcode

        http.Open "GET", url, False
        http.send

        If http.Status = 200 Then
            html.body.innerHTML = http.responseText

            On Error Resume Next
            productName = html.getElementsByClassName("product_description")(0).innerText
            productImage = html.getElementsByTagName("img")(0).getAttribute("src")
            On Error GoTo 0

            If productName = "" Then
                productName = "Nome não encontrado"
            End If

            If productImage = "" Then
                productImage = "Imagem não encontrada"
            End If

            ws.Cells(i, 2).Value = productName
            ws.Cells(i, 3).Value = productImage
        Else
            ws.Cells(i, 2).Value = "Erro ao buscar"
            ws.Cells(i, 3).Value = "Erro ao buscar"
        End If
    Next i

    Set http = Nothing
    Set html = Nothing
End Sub