VBA HTML Listing Info Pull

Question

I am looking to follow a series of URL\'s that are found in column A (example: https://www.ebay.com/itm/Apple-iPhone-7-GSM-Unlocked-Verizon-AT-T-TMobile-Sprint-32GB-128GB-256GB/

Answer 1

Here's an approach using Web Requests, using MSXML. It should be significantly faster than using IE, and I'd encourage you to strongly consider using this approach wherever possible.

You'll need references to Microsoft HTML Object Library and Microsoft XML v6.0 to get this working.

Option Explicit

Public Sub SubmitRequest()
    Dim URLs                              As Excel.Range
    Dim URL                               As Excel.Range
    Dim LastRow                           As Long
    Dim wb                                As Excel.Workbook: Set wb = ThisWorkbook
    Dim ws                                As Excel.Worksheet: Set ws = wb.Worksheets(1)
    Dim ListingDetail                     As Variant
    Dim i                                 As Long
    Dim j                                 As Long
    Dim html                              As HTMLDocument

    ReDim ListingDetail(0 To 2, 0 To 10000)

    'Get URLs
    With ws
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set URLs = .Range(.Cells(1, 1), .Cells(LastRow, 1))
    End With

    'Update the ListingDetail
    For Each URL In URLs
        Set html = getHTML(URL.Value2)
        ListingDetail(0, i) = html.getElementByID("itemTitle").innertext 'Title
        ListingDetail(1, i) = html.getElementByID("prcIsum").innertext 'Price
        ListingDetail(2, i) = html.getElementsByClassName("viSNotesCnt")(0).innertext 'Seller Notes
        i = i + 1
    Next

    'Resize array
    ReDim Preserve ListingDetail(0 To 2, 0 To i - 1)

    'Dump in Column T,U,V of existing sheet
    ws.Range("T1:V" & i).Value = WorksheetFunction.Transpose(ListingDetail)
End Sub

Private Function getHTML(ByVal URL As String) As HTMLDocument
    'Add a reference to Microsoft HTML Object Library
    Set getHTML = New HTMLDocument

    With New MSXML2.XMLHTTP60
        .Open "GET", URL
        .send
        getHTML.body.innerHTML = .responseText
    End With
End Function