Web Scraping with VBA: Extract Website Data into Excel (with Proxies + Retry Logic)

Option Explicit

Private Function HttpGet(ByVal url As String, Optional ByVal timeoutMs As Long = 30000) As String
    Dim http As Object
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")

    http.Open "GET", url, False

    http.SetTimeouts timeoutMs, timeoutMs, timeoutMs, timeoutMs

    http.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/123 Safari/537.36"
    http.SetRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
    http.SetRequestHeader "Accept-Language", "en-US,en;q=0.9"

    http.Send

    If http.Status < 200 Or http.Status >= 300 Then
        Err.Raise vbObjectError + 101, "HttpGet", "HTTP " & http.Status & " for " & url
    End If

    HttpGet = http.ResponseText
End Function

Private Function HtmlDoc(ByVal html As String) As Object
    Dim doc As Object
    Set doc = CreateObject("htmlfile")

    doc.Open
    doc.Write html
    doc.Close

    Set HtmlDoc = doc
End Function

Private Function GetInnerTextBySelector(ByVal doc As Object, ByVal tagName As String, ByVal className As String) As String
    Dim el As Object
    Dim els As Object

    Set els = doc.getElementsByTagName(tagName)

    For Each el In els
        If InStr(1, " " & el.className & " ", " " & className & " ", vbTextCompare) > 0 Then
            GetInnerTextBySelector = Trim(el.innerText)
            Exit Function
        End If
    Next el

    GetInnerTextBySelector = ""
End Function

Private Function HttpGetWithRetry(ByVal url As String, Optional ByVal attempts As Integer = 5) As String
    Dim i As Integer
    Dim delayMs As Long

    delayMs = 1000

    For i = 1 To attempts
        On Error GoTo TryFail
        HttpGetWithRetry = HttpGet(url, 30000)
        Exit Function

TryFail:
        On Error GoTo 0
        If i = attempts Then
            Err.Raise vbObjectError + 102, "HttpGetWithRetry", "Failed after retries: " & url
        End If

        ' Backoff (1s, 2s, 4s, 8s...)
        Sleep delayMs
        delayMs = delayMs * 2
    Next i
End Function

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Public Sub ScrapePaginatedList()
    Dim baseUrl As String
    Dim page As Integer
    Dim html As String

    baseUrl = "https://example.com/list?page="

    For page = 1 To 5
        html = HttpGetWithRetry(baseUrl & CStr(page), 5)
        ' parse html and write rows to sheet
        Debug.Print "page", page, "len", Len(html)
    Next page
End Sub

Private Function HttpGetViaProxy(ByVal url As String, ByVal proxy As String) As String
    Dim http As Object
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")

    http.Open "GET", url, False

    ' proxy format for WinHTTP:
    ' "http=HOST:PORT;https=HOST:PORT"
    http.SetProxy 2, proxy

    http.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/123 Safari/537.36"

    http.Send

    If http.Status < 200 Or http.Status >= 300 Then
        Err.Raise vbObjectError + 103, "HttpGetViaProxy", "HTTP " & http.Status & " via proxy for " & url
    End If

    HttpGetViaProxy = http.ResponseText
End Function

Private Sub WriteRow(ByVal rowIndex As Long, ByVal title As String, ByVal url As String, ByVal price As String)
    With ThisWorkbook.Worksheets("Data")
        .Cells(rowIndex, 1).Value = title
        .Cells(rowIndex, 2).Value = url
        .Cells(rowIndex, 3).Value = price
    End With
End Sub

Public Sub ScrapeExampleToSheet()
    Dim html As String
    Dim doc As Object
    Dim title As String

    html = HttpGetWithRetry("https://example.com/products", 5)
    Set doc = HtmlDoc(html)

    title = GetInnerTextBySelector(doc, "h1", "product-title")

    WriteRow 2, title, "https://example.com/products", ""
End Sub