Web Scraping VBA: Extract Data from Websites into Excel (Tables + Pagination)

Option Explicit

Private Function HttpGet(ByVal url As String) As String
    Dim http As WinHttp.WinHttpRequest
    Set http = New WinHttp.WinHttpRequest

    http.SetTimeouts 10000, 10000, 10000, 30000 ' resolve, connect, send, receive
    http.Open "GET", url, False
    http.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64)"
    http.SetRequestHeader "Accept-Language", "en-US,en;q=0.9"
    http.Send

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

    HttpGet = http.ResponseText
End Function

Private Function HttpGetWithRetry(ByVal url As String, Optional ByVal maxRetries As Long = 4) As String
    Dim attempt As Long

    For attempt = 1 To maxRetries
        On Error GoTo TryFail
        HttpGetWithRetry = HttpGet(url)
        Exit Function

TryFail:
        If attempt = maxRetries Then
            Err.Raise Err.Number, Err.Source, Err.Description
        End If
        Application.Wait Now + TimeSerial(0, 0, 2 ^ (attempt - 1))
    Next attempt
End Function

Private Function ParseHtml(ByVal html As String) As MSHTML.HTMLDocument
    Dim doc As MSHTML.HTMLDocument
    Set doc = New MSHTML.HTMLDocument
    doc.body.innerHTML = html
    Set ParseHtml = doc
End Function

Private Sub WriteFirstTableToSheet(ByVal doc As MSHTML.HTMLDocument, ByVal ws As Worksheet)
    Dim tbl As MSHTML.HTMLTable
    Dim r As Long, c As Long
    Dim row As MSHTML.HTMLTableRow
    Dim cell As MSHTML.HTMLTableCell

    Set tbl = doc.querySelector("table")
    If tbl Is Nothing Then Err.Raise vbObjectError + 2000, "WriteFirstTableToSheet", "No <table> found"

    r = 1
    For Each row In tbl.Rows
        c = 1
        For Each cell In row.Cells
            ws.Cells(r, c).Value = Trim$(cell.innerText)
            c = c + 1
        Next cell
        r = r + 1
    Next row
End Sub

Private Function BuildPageUrl(ByVal baseUrl As String, ByVal pageNum As Long) As String
    If InStr(1, baseUrl, "?", vbTextCompare) > 0 Then
        BuildPageUrl = baseUrl & "&page=" & CStr(pageNum)
    Else
        BuildPageUrl = baseUrl & "?page=" & CStr(pageNum)
    End If
End Function

Public Sub ScrapePagedTable()
    Dim baseUrl As String
    baseUrl = "https://example.com/list"

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Cells.Clear

    Dim pageNum As Long, outRow As Long
    Dim lastFirstCell As String
    outRow = 1

    For pageNum = 1 To 10
        Dim url As String
        url = BuildPageUrl(baseUrl, pageNum)

        Dim html As String
        html = HttpGetWithRetry(url)

        Dim doc As MSHTML.HTMLDocument
        Set doc = ParseHtml(html)

        Dim tbl As MSHTML.HTMLTable
        Set tbl = doc.querySelector("table")
        If tbl Is Nothing Then Exit For

        Dim firstCellText As String
        If tbl.Rows.Length = 0 Or tbl.Rows(0).Cells.Length = 0 Then Exit For
        firstCellText = Trim$(tbl.Rows(0).Cells(0).innerText)

        If firstCellText = lastFirstCell Then Exit For
        lastFirstCell = firstCellText

        ' Write table under the previous output
        ws.Cells(outRow, 1).Value = "Page " & pageNum
        outRow = outRow + 1

        ' Simple table write (you can adapt to skip headers)
        Dim row As MSHTML.HTMLTableRow, cell As MSHTML.HTMLTableCell
        Dim r As Long, c As Long
        r = outRow
        For Each row In tbl.Rows
            c = 1
            For Each cell In row.Cells
                ws.Cells(r, c).Value = Trim$(cell.innerText)
                c = c + 1
            Next cell
            r = r + 1
        Next row
        outRow = r + 1
    Next pageNum
End Sub

http://api.proxiesapi.com/?auth_key=YOUR_KEY&url=https://target.com/page