VBA HTML Навигация по спискам - PullRequest
0 голосов
/ 05 января 2019

У меня есть следующий код, который работает, и тянет все ссылки для списков на веб-странице ниже. Сейчас я хочу расширить это, чтобы вытащить следующую страницу результатов (до n). Я попытался сделать это (вторая половина этого кода), но ничего не отображается.

ПРИМЕЧАНИЕ. В этом примере кода я пытался разместить вторую страницу ссылок в столбце B, но в идеальном мире я хотел бы добавить ссылки внизу результатов страницы 1 (в Колонка А).

ОБНОВЛЕНИЕ: Этот код теперь перемещается к каждому результату страницы, но он вставляет те же ссылки в столбце А, что и В, что и в С и т. Д. Я не уверен, как это происходит, поскольку я могу наблюдать, как браузер меняет URL-адреса в процессе работы.

Кроме того, если у вас есть более эффективные способы сделать это (вместо того, чтобы копировать / вставлять эти 10x, чтобы получить количество результатов, которое я ищу), пожалуйста, дайте мне знать!

Option Explicit
Public Sub GetLinks()
Dim ie As New InternetExplorer, ws As Worksheet, t As Date
Dim k As Integer
Const MAX_WAIT_SEC As Long = 10
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ie
    .Visible = True
k = 0
Do While k < 10
    .Navigate2 "https://www.ebay.com/sch/i.html?_from=R40&_nkw=iPhone&_sacat=0&_ipg=200&_pgn=" & k

    While .Busy Or .readyState < 4: DoEvents: Wend

    Dim Links As Object, i As Long, count As Long
    t = Timer
    Do
        On Error Resume Next
        Set Links = .Document.querySelectorAll(".s-item__link[href]")
        count = Links.Length
        On Error GoTo 0
        If Timer - t > MAX_WAIT_SEC Then Exit Do
    Loop While count = 0
    For i = 0 To Links.Length - 1
        ws.Cells(i + 1, k + 1) = Links.item(i)
    Next
    k = k + 1
Loop

    .Quit
End With
End Sub

Ответы [ 2 ]

0 голосов
/ 05 января 2019

Возможно, я бы хотел добавить тест, чтобы убедиться, что количество запрашиваемых страниц не превышает доступное. Немного модифицируйте код, чтобы вытащить шаг извлечения информации. Используйте массивы и некоторую базовую оптимизацию (Screenupdating), чтобы ускорить весь процесс. Также избавьтесь от объекта ie как можно скорее.

Это с счетчиком результатов списков, установленным в 200 (который фактически дает 211 результатов на страницу с данным селектором). Не уверен, что это просто настройка ebay, которая запоминается или используется по умолчанию.

Option Explicit
Public Sub GetInfo()
    Dim ie As InternetExplorer, nodeList As Object, page As Long, totalResults As Long, ws As Worksheet
    Const RESULTS_PER_PAGE = 211
    Const DESIRED_PAGES = 3
    Const BASE = "https://www.ebay.com/sch/i.html?_from=R40&_nkw=iPhone&_sacat=0&_ipg=200&_pgn="
    Dim results(), url As String, maxPages As Long
    ReDim results(1 To DESIRED_PAGES)
    Application.ScreenUpdating = False
    Set ie = New InternetExplorer
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ie
        .Visible = True
        For page = 1 To DESIRED_PAGES
            url = BASE & page
            .Navigate2 url
            While .Busy Or .readyState < 4: DoEvents: Wend
            If page = 1 Then
                totalResults = Replace$(.document.querySelector(".srp-controls__count-heading").innerText, " results", vbNullString)
                maxPages = totalResults / RESULTS_PER_PAGE
            End If
            Set nodeList = .document.querySelectorAll("#srp-river-results .s-item__link[href]")
            results(page) = GetLinks(nodeList)
            Set nodeList = Nothing
            If page + 1 >= maxPages Then Exit For
        Next
        .Quit
    End With
    If maxPages < DESIRED_PAGES Then ReDim Preserve results(1 To maxPages)
    For page = LBound(results) To UBound(results)
        If page = 1 Then
            ws.Cells(1, 1).Resize(UBound(results(page), 1)) = Application.Transpose(results(page))
        Else
            ws.Cells(GetLastRow(ws, 1) + 1, 1).Resize(UBound(results(page), 1)) = Application.Transpose(results(page))
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Public Function GetLinks(ByVal nodeList As Object) As Variant
    Dim results(), i As Long
    ReDim results(1 To nodeList.Length)
    For i = 0 To nodeList.Length - 1
        results(i + 1) = nodeList.item(i)
    Next
    GetLinks = results
End Function

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
0 голосов
/ 05 января 2019

Не проверено (возможно, я что-то упустил), но, похоже, вы можете просто указать страницу, к которой хотите получить доступ, с параметром запроса URL _pgn.

Так, например, перейдя по URL-адресу ниже:

https://www.ebay.com/sch/i.html?_from=R40&_nkw=iPhone&_sacat=0&_ipg=200&_pgn=2

означает, что вы запрашиваете страницу 2 (кроме того, параметр _ipg, по-видимому, определяет, сколько результатов отображается на странице, поэтому увеличение до 200 может означать, что вам нужно сделать меньше запросов в целом).

Таким образом, если вы создадите некоторую переменную pageNumber в своем коде и увеличите ее внутри некоторого цикла (который завершается, как только вы достигнете последней страницы), вы сможете получить все страницы - или даже любую страницу по произвольному индексу - без копирования-вставки / повторения себя в вашем коде.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...