DuckDuck Go Скребок, нельзя go на следующую страницу

Question

Я написал код парсинга URL, который работает в bing и Google и отлично перемещается по страницам.

Сейчас я пытаюсь настроить его для работы на duckduck go .com. У меня он работает, поэтому он соскабливает с одной страницы. ЕДИНСТВЕННАЯ проблема, с которой я сталкиваюсь, - это Я НЕ МОГУ тренироваться, как заставить его показывать больше результатов, как ориентироваться. Он извлекает результаты только с первой страницы.

У Google и Bing есть следующая кнопка, по которой код может перемещаться, однако я не могу понять, как это сделать для duckduck go. Я застрял на этом последнем бите. Остальное в порядке. Результаты поиска, страницы для навигации и 2x задержки поступают из Sheet10

Мне НЕ нужно полностью переписывать код. Все, что мне нужно, это то, как перемещаться по страницам.

Private Sub duckduckgoScraper()
'''DuckDuckGo URL SCRAPER
Dim ie As Object
Dim HTMLdoc As Object
Dim nextPageElement As Object
Dim div As Object
Dim link As Object
Dim url As String
Dim pageNumber As Long
Dim i As Long
Dim myCounter As Long

'''Takes search from Sheet10 to DuckDuckGo
    url = "https://duckduckgo.com/?q=" & Replace(Worksheets("Sheet10").Range("G17").Value & Range("H17").Value, " ", "+")
Set ie = CreateObject("InternetExplorer.Application")
    
With ie
    .Visible = True
    .navigate url
Do While .Busy Or .readyState <> 4
    DoEvents
Loop
End With

Application.Wait Now + TimeSerial(0, 0, 5)
    Set HTMLdoc = ie.document

'''Searches URLS and places them in Sheet called Sheet2  ROW 2 Column A
With Sheets("Sheet2")
    pageNumber = 1
    i = 2
Do
    For Each div In HTMLdoc.getElementsByTagName("div")
        If div.getAttribute("class") = "result__body links_main links_deep" Then
            Set link = div.getElementsByTagName("a")(0)
            .Cells(i, 1).Value = link.getAttribute("href")
            i = i + 1
        End If
    Next div
            
'''Searches Number of Pages entered in Sheet10
    If pageNumber >= Replace(Worksheets("Sheet10").Range("I17").Value, " ", "+") Then Exit Do
        On Error Resume Next

'''################################################################################################
'''##########################  **I am stuck here, the rest is fine**  #############################
'''################################################################################################
        Set nextPageElement = HTMLdoc.getElementByClassName("I NEED THIS BIT, I AM STUCK HERE")
    If nextPageElement Is Nothing Then Exit Do
 
       
'''Scrolls Down the Browser
    ie.document.parentWindow.Scroll 0&, 99999
'''Random delay from Max number entered in Sheet10
    Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Sheet10").Range("J17").Value))
'''Click the next page
        nextPageElement.Click 
    Do While ie.Busy Or ie.readyState <> 4
        DoEvents
    Loop
'''Random delay from Max number entered in Sheet10
    Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Sheet10").Range("K17").Value))
        Set HTMLdoc = ie.document
''' Delete duplicates
    Sheet2.Columns("A").RemoveDuplicates Columns:=Array(1), Header:=xlYes
''' Delete Row If Blank
    Sheet2.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        pageNumber = pageNumber + 1
myCounter = myCounter + 1
Worksheets("Sheet10").Range("G6").Value = myCounter
    Loop
End With

'''Quite browser and clear
ie.Quit
    Set ie = Nothing
    Set HTMLdoc = Nothing
    Set nextPageElement = Nothing
    Set div = Nothing
    Set link = Nothing

''' To stop the code early, change page number to 0, else code will finish when page number completed
If Sheet10.Range("I17") = 0 Then
    Complete.Show
        Termination.Hide
ElseIf Sheet10.Range("I17") > 0 Then
    Complete.Show
End If
End Sub

Что я пробовал до сих пор Я попробовал биты, выделенные желтым, но не могу работать. При нажатии следующей кнопки rld-1 изменится на rdl-2 и 3. Это единственное, на чем я сейчас застрял. введите описание изображения здесь

Подскажите, пожалуйста. Я думаю, это может быть из-за того, что это JavaScript, но у меня ограниченные знания в программировании, и я застрял на этом уже несколько дней.

Как всегда, заранее спасибо

Answer 1

Попробуйте нажать кнопку «Дополнительные результаты», чтобы сначала загрузить все страницы. Я сделал это, используя такие строки

    Dim objMoreResults As Object, p As Long
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .Navigate url
        Do While .Busy Or .readyState <> 4: DoEvents: Loop
    End With
    p = 1
backP:
    On Error Resume Next
        Set objMoreResults = ie.document.getElementById("rld-" & p)
    On Error GoTo 0
    If Not objMoreResults Is Nothing Then
        objMoreResults.getElementsByTagName("a")(0).Click
        Set objMoreResults = Nothing: p = p + 1
        Application.Wait Now + TimeSerial(0, 0, 3): GoTo backP
    End If

Это полный код, который у меня работает нормально. Сначала попробуйте этот код, прежде чем пытаться отредактировать строки кода, чтобы увидеть, работает ли этот код

Sub DuckDuckGo_Scraper()
    Dim x, ie As Object, objMoreResults As Object, htmlDoc As Object, div As Object, sURL As String, p As Long, i As Long
    x = Application.InputBox("Enter The Number Of Pages", , 2)
    If Not IsNumeric(x) Then Exit Sub
    p = 1: i = 1
    sURL = "https://duckduckgo.com/?q=" & Replace(Worksheets("Sheet10").Range("G17").Value & Range("H17").Value, " ", "+")
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .Navigate sURL
        Do While .Busy Or .readyState <> 4: DoEvents: Loop
BackP:
        On Error Resume Next
            Set objMoreResults = ie.document.getElementById("rld-" & p)
        On Error GoTo 0
        If Not objMoreResults Is Nothing Then
            objMoreResults.getElementsByTagName("a")(0).Click
            Set objMoreResults = Nothing: p = p + 1: If p = Val(x) Then GoTo NextP
            Application.Wait Now + TimeSerial(0, 0, 3): GoTo BackP
        End If
NextP:
        Application.Wait Now + TimeSerial(0, 0, 3)
        Set htmlDoc = .document
        For Each div In htmlDoc.getElementsByClassName("result__title")
            i = i + 1
            Worksheets("Sheet2").Cells(i, 1).Value = div.getElementsByTagName("a")(0).href
        Next div
        .Quit
    End With
    Set ie = Nothing: Set htmlDoc = Nothing: Set div = Nothing
End Sub

Answer 2

Хорошо, это не лучший код в мире, но он работает. БОЛЬШОЕ спасибо Ясиру Халилю, без него я бы не справился. Мне пришлось внести изменения в оба кода, чтобы он заработал. Еще раз спасибо Ясир Халил

Private Sub duckduckgoScraper()
'''DuckDuckGo URL SCRAPER
Dim ie As Object
Dim HTMLdoc As Object
Dim div As Object
Dim link As Object
Dim url As String
Dim i As Long
Dim myCounter As Long
Dim objMoreResults As Object
Dim p As Long

'''Takes seach from Sheet10 to google
    url = "https://duckduckgo.com/?q=" & Replace(Worksheets("Sheet10").Range("G17").Value & Range("H17").Value, " ", "+")
On Error Resume Next
Set ie = CreateObject("InternetExplorer.Application")

With ie
    .Visible = True
    .navigate url
Do While .Busy Or .readyState <> 4
    DoEvents
Loop
End With

Application.Wait Now + TimeSerial(0, 0, 5)
    Set HTMLdoc = ie.document

'''Searches URLS and places them in Sheet called Sheet2  ROW 2 Column A
With Sheets("Sheet2")
    pageNumber = 1
    i = 2

Do
    p = 1
backP:

Set objMoreResults = ie.document.getElementById("rld-" & p)
    On Error GoTo 0
''' End do in NO MORE results
   If objMoreResults Is Nothing Then Exit Do
'''If objMoreResults not same as pages requested on sheet10 I17
  If objMoreResults <> Sheet10.Range("I17").Value Then
        objMoreResults.getElementsByTagName("a")(0).Click
  Set objMoreResults = Nothing: p = p + 1
'''Scrolls Down the Browser
    ie.document.parentWindow.Scroll 0&, 99999
'''Random delay from Max number entered in Sheet10
    Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Sheet10").Range("J17").Value))
       ' nextPageElement.Click 'next web page
    Do While ie.Busy Or ie.readyState <> 4
        DoEvents
    Loop
'''Random delay from Max number entered in Sheet10
    Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Sheet10").Range("K17").Value))
    Set HTMLdoc = ie.document

    On Error Resume Next
''' extract urls
    For Each div In HTMLdoc.getElementsByTagName("div")
        If div.getAttribute("class") = "result__body links_main links_deep" Then
         'If div.getAttribute("class") = "result__a" Then
            Set link = div.getElementsByTagName("a")(0)
            .Cells(i, 1).Value = link.getAttribute("href")
            i = i + 1
        End If
    Next div

'''' Delete duplicates
    Sheet2.Columns("A").RemoveDuplicates Columns:=Array(1), Header:=xlYes
'''' Delete Row If Blank
    Sheet2.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        'pageNumber = pageNumber + 1
''' Loop Counter
myCounter = myCounter + 1
    Worksheets("Sheet10").Range("G6").Value = myCounter
''' If same as Sheet10 G6 then end
If Sheet10.Range("G6").Value = Sheet10.Range("I17").Value Then Exit Do

Application.Wait Now + TimeSerial(0, 0, 3):
GoTo backP
End If

Loop
End With

ie.Quit
    Set ie = Nothing
    Set HTMLdoc = Nothing
    Set objMoreResults = Nothing
    Set div = Nothing
    Set link = Nothing

If Sheet10.Range("I17") = 0 Then
    Complete.Show
        Termination.Hide
ElseIf Sheet10.Range("I17") > 0 Then
    Complete.Show
End If
End Sub