I want to draw data from the web with Excel macro

Question

I want to take old programs from http://arsiv.sahadan.com/genis_ekran_iddaa_programi/ . For this I modified the macro with the module called @QHarr, but I couldn't handle the tables. Macro doesn't work.

    Public Sub Deneme()
    Application.ScreenUpdating = False
    Sheets("X").Select
    Cells.Delete Shift:=xlUp
    Range("A1").Select
    Dim url As String, ws As Worksheet, html As HTMLDocument, http As clsHTTP, hTable As HTMLTable
    Dim headerRow As Boolean, trow As Object, tRows As Object, tCell As Object, tCells As Object
    Dim iRow As Long, R As Long, C As Long, Hsay As Long, numberOfRequests As Long
    Dim hafta(), results(), headers()
    headers = Array("Hsay", "Saat", "Lig", "Kod", "MBS", "Ev Sahibi", "Misafir", "IY", "MS", "MS1", "MSX", "MS2", "IY1", "IYX", "IY2", "he", "H1", "HX", "H2", "hm", "KGV", "GVY", "CS1/X", "CS1/2", "X/2", "IY1,5A", "IY1,5U", "1,5A", "1,5U", "2,5A", "2,5U", "3,5A", "3,5U", "TG01", "TG23", "TG46", "7+")
    Set http = New clsHTTP
    Set ws = ThisWorkbook.Worksheets("X")
    Set html = New HTMLDocument
    hafta = Application.Transpose(Sheets("Y").Range("A1:A" & Sheets("Y").Range("A1048576").End(xlUp).Row).Value)
    Const numTableRows As Long = 500
    Const numTableColumns As Long = 37
    Const BASE_URL As String = "http://arsiv.sahadan.com/LargeProgram.aspx?"
    numberOfRequests = UBound(hafta)
    ReDim results(1 To numTableRows * numberOfRequests, 1 To numTableColumns)
    For Hsay = 1 To numberOfRequests
        headerRow = True
        url = BASE_URL & "id=weekId&value=" & hafta(Hsay)
        html.body.innerHTML = http.GetString(url)
        Set hTable = html.querySelector("dvLargeHead")
        Set tRows = hTable.getElementsByTagName("tr")
        For Each trow In tRows
            If Not headerRow Then
                C = 2: R = R + 1
                results(R, 1) = hafta(Hsay)
                Set tCells = trow.getElementsByTagName("td")
                For Each tCell In tCells
                    results(R, C) = tCell.innerText
                    C = C + 1
                Next
            End If
            headerRow = False
        Next
    Next
    With ws
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

Answer 1

I cannot successfully reproduce the ajax requests that are used to update the page. I get Access Denied which makes me think there must be some protocol/authentication I am missing beyond the simple query string part.

Below is an example using selenium basic. It is slow as I am copying all the formatting across as the layout is a little finicky.

I have written something without using the clipboard which I may add later if I am happy with. It is a lot faster.

Option Explicit

Public Sub GetInfo()
    Dim d As WebDriver, clipboard As Object
    Dim ele As Object, ws As Worksheet, t As Date, weeks As Object, i As Long
    Const MAX_WAIT_SEC As Long = 15
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set d = New ChromeDriver
    Const URL = "http://arsiv.sahadan.com/genis_ekran_iddaa_programi/"

    With d
        .Start "Chrome"
        .get URL, timeout:=90000

        Set weeks = .FindElementsByCss("#weekId option")
        .FindElementByCss("[value='-1']").Click
        For i = 1 To weeks.Count
            If i > 1 Then
                .FindElementsByCss("#weekId option")(i).Click
            End If
            Dim html As HTMLDocument
            Set html = New HTMLDocument
            t = Timer
            Do
                DoEvents
                On Error Resume Next
                Set ele = .FindElementByCss("#dvLarge #resultsList")
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While ele Is Nothing

            If Not ele Is Nothing Then
                clipboard.SetText ele.Attribute("outerHTML")
                clipboard.PutInClipboard
                ws.Cells.UnMerge
                Application.Wait Now + TimeSerial(0, 0, 1)
                ws.Cells(GetLastRow(ws, 1) + 1, 1).PasteSpecial
                Application.Wait Now + TimeSerial(0, 0, 3)
            End If

            Set ele = Nothing
        Next
        .Quit
    End With

End Sub

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function