Accessing web USING VBA to collect data

[raghib]

Hey folks,
I'm hoping someone can help me out with a VBA code. I need something that will open the website Heavy Duty Truck Parts Online, Medium Duty, Light Duty - FinditParts, search for the PartNo located in Column A, on the website, and provide the results in Column B. The result should be the product description.

Attaching the file to show input and output. Thank you.

Input sheet:

PartNo	ProductDescription
1492193
8891040

Output sheet:

PartNo	ProductDescription
1492193	BUYERS PRODUCTS 1492193 - 4in. Square LED Flood Light with Switch and Handle
8891040	BUYERS PRODUCTS 8891040 - 11in. Rectangular Multi-Mount Amber LED Mini Light Bar

 

[nguyendang]

You can use the following function to get the product description per part number:

Option Explicit

'Add references to Microsoft WinHttp Services, version 5.1 and Microsoft HTML Object Library
Public Function GetFindItPartsProductInfo(ByVal PartNumber As Variant) As String
    If IsArray(PartNumber) = False Then
        Dim objWinHttp As WinHttp.WinHttpRequest
        Set objWinHttp = New WinHttp.WinHttpRequest
        With objWinHttp
            .Open "GET", "https://www.finditparts.com/search?utf8=%E2%9C%93&s=" & CStr(PartNumber) & "&aggs=true&page=1&aggs=1&strict_phrase=1&commit=", True
            .SetRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.7"
            .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/113.0.0.0 Safari/537.36 Edg/113.0.1774.50"
            .Send
            .WaitForResponse
            If .Status = 200 Then
                Dim objHtmlDoc As MSHTML.HTMLDocument
                Set objHtmlDoc = New MSHTML.HTMLDocument
                objHtmlDoc.Body.innerHTML = .ResponseText
                Dim objHtmlSpanElement As MSHTML.HTMLSpanElement
                Set objHtmlSpanElement = objHtmlDoc.querySelector("[itemprop='description']")
                Dim strDescription As String
                strDescription = Trim(objHtmlSpanElement.textContent)
                Dim objHtmlManufacturerElement As MSHTML.HTMLSpanElement
                Set objHtmlManufacturerElement = objHtmlDoc.getElementsByClassName("manufacturer").Item(0)
                Dim strManufacturer As String
               strManufacturer = Trim(objHtmlManufacturerElement.textContent)
                GetFindItPartsProductInfo = strManufacturer & " " & CStr(PartNumber) & " - " & strDescription
            End If
        End With
    End If
End Function

 

[raghib]

Thank you for your efforts however this code is not working and keeps asking macro name. Can you advise what I have been doing wrong?

 

[nguyendang]

Thank you for your efforts however this code is not working and keeps asking macro name. Can you advise what I have been doing wrong?

You could download this .xlsm workbook, then check to see if the code is working.
For example, "=GetFindItPartsProductInfo(B3)".