Прежде всего, давайте проясним, как работает процесс загрузки новых порций предметов. В браузере e. г. Chrome, нажмите F12 , чтобы открыть DevTools, перейдите к https://www.tayara.tn/sc/immobilier/appartements,, прокрутите вниз и загрузите несколько новых элементов, перейдите на вкладку Сеть, установите фильтр на XHR, он будет выглядеть так, как показано ниже:
Вы можете заметить, что каждый раз, когда вы нажимаете кнопку «Montrer plus», регистрируется новый запрос размером около 5 КБ. В ответе есть все необходимые данные:
Чтобы создать такой XHR, вам нужно извлечь значение data.listings.pageInfo.endCursor из предыдущего ответа и поместить его как свойство variables.page.offset в полезную нагрузку запроса, конечно же, вам нужно также сохранить всю структуру полезной нагрузки и добавить соответствующую заголовки:
Относительно variables.page.offset собственности. На самом деле он состоит из трех частей, закодированных в Base64, после декодирования очевидно, что e. г. cDEwbg==.MjAxOS0wMS0yNlQyMDoyMTo1OFo=.NjAwMA== - это некоторый префикс p10n + дата начала 2019-01-26T20:21:58Z + всего найденных элементов 6000. Таким образом, вы можете запросить любую другую часть предметов, изменив последнее значение. Кроме того, вы можете указать количество элементов для запроса в variables.page.count свойстве (кажется, ограничение составляет 100).
Вот пример VBA, показывающий, как можно выполнить такую очистку. Импорт JSON.bas модуля в проект VBA для обработки JSON.
Option Explicit
Sub Test()
Dim sCat As String
Dim oResSht As Worksheet
Dim oResCell As Range
Dim lNextOutput As Long
Dim sOffset As String
Dim oRes As Object
Dim sPayload As String
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aItems
Dim oItem
' Set category for parsing
sCat = "2"
' Set output sheet
Set oResSht = ThisWorkbook.Sheets(1)
With oResSht
.Cells.Delete
.Cells.WrapText = False
Set oResCell = .Cells(1, 1)
End With
lNextOutput = 1000
sOffset = ""
Set oRes = CreateObject("Scripting.Dictionary")
Do
' Retrieve JSON content
sPayload = _
"{""query"":""query ListingsPage($page: Page, $filter: SearchFilter, $sortBy: SortOrder) {\n listings: searchAds(page: $page, filter: $filter, sortBy: $sortBy) " & _
"{\n items {\n uuid\n title\n price\n currency\n thumbnail\n createdAt\n state\n category " & _
"{\n id\n name\n engName\n __typename\n }\n user {\n uuid\n displayName\n avatar(width: 96, height: 96) " & _
"{\n url\n __typename\n }\n __typename\n }\n __typename\n }\n trackingInfo " & _
"{\n transactionId\n listName\n recommenderId\n experimentId\n variantId\n __typename\n }\n totalCount\n pageInfo " & _
"{\n startCursor\n hasPreviousPage\n endCursor\n hasNextPage\n __typename\n }\n __typename\n }\n}\n""," & _
"""variables"":{""page"":{""count"":100,""offset"":""" & sOffset & """},""filter"":{""queryString"":null,""category"":""" & sCat & """,""regionId"":null,""attributeFilters"":[]},""sortBy"":""CREATED_DESC""},""operationName"":""ListingsPage""}"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://www.tayara.tn/graphql", True
.setRequestHeader "content-type", "application/json"
'.setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/70.0.3538.110 Safari/537.36"
.setRequestHeader "content-length", Len(sPayload)
.send (sPayload)
Do Until .readyState = 4: DoEvents: Loop
sJSONString = .responseText
End With
' Parse JSON sample
JSON.Parse sJSONString, vJSON, sState
Select Case True
Case sState <> "Object"
Debug.Print Now & " Invalid JSON response"
Case IsNull(vJSON("data"))
Debug.Print Now & " Response contains no data"
Case Else
' Retrieve items
aItems = vJSON("data")("listings")("items")
' Add retrieved items to resulting dataset
For Each oItem In aItems
Set oRes(oRes.Count) = oItem
Next
' Check if the page is last
If vJSON("data")("listings")("pageInfo")("hasNextPage") = False Then Exit Do
' Retrieve offset property for next page request
sOffset = vJSON("data")("listings")("pageInfo")("endCursor")
Debug.Print Now & " " & sOffset
' Output once per 1000 parsed items
If oRes.Count >= lNextOutput Then
Output oRes, oResCell
lNextOutput = oRes.Count + 1000
End If
End Select
DoEvents
Loop
' Finally output results
Output oRes, oResCell
MsgBox "Completed" & vbCrLf & "Actually parsed: " & oRes.Count & vbCrLf & """totalCount"" from API response: " & vJSON("data")("listings")("totalCount")
End Sub
Sub Output(vData, oTarget As Range)
Dim aData()
Dim aHeader()
' Convert raw JSON to 2d array and output to target range
JSON.ToArray vData, aData, aHeader
With oTarget
OutputArray oTarget.Cells(1, 1), aHeader
Output2DArray oTarget.Cells(1, 1).Offset(1, 0), aData
.Parent.Columns.AutoFit
End With
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
Вывод для меня следующий:
Кстати, аналогичный подход применяется в других ответах .