问题
My code all of a sudden does not seem to want to work and I can not work out why. Most of it is fine, there are only two issue with it now and I can not work them out. I was trying to improve it and may have moved someting around and can not work out what I have done. I need a some one to look at this for me please. I have highlighted the issue in the code that are the problem. The bulk of this is fine and I am happy with it.
- It no longer clicks on the next page in Bing
- It Loops minus 2, so if I put in 10 loops then it does 8. Maybe I have put the loop counter in the wrong place, hence it could be showing wrong results
Its not the best code in the world, but it was something I wrote and it worked fine up until a few weeks back. I have been trying to fix it but can not work it out so decided to post.
What I have done so Far.
- I tried to google the answer
- I tried to fix it myself. I managed to fix other smaller bugs but can't fix navigation
- I Checked the BING CLASS for next page, looks the same to me. I have always used the one in yellow
Private Sub BingScraper()
'''Bing URL SCRAPER
Dim ie As Object
Dim HTMLdoc As Object
Dim nextPageElements As Object
Dim li As Object
Dim link As Object
Dim url As String
Dim pageNumber As Long
Dim i As Long
Dim myCounter As Long
'''Takes seach from Sheet10 to google
url = "https://www.Bing.com/search?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 = 2
'i = 2
i = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).row + 1
Do
For Each li In HTMLdoc.getElementsByTagName("li")
' Application.ScreenUpdating = False
If li.getAttribute("class") = "b_algo" Then
Set link = li.getElementsByTagName("a")(0)
.Cells(i, 1).Value = link.getAttribute("href")
i = i + 1
End If
Next li
'#####################################################################################
'################################# ISSUE STARTS FROM HERE ############################
'''Searches Number of Pages entered in Sheet10 i17
If pageNumber >= Replace(Worksheets("Sheet10").Range("I17").Value, " ", "+") Then Exit Do
On Error Resume Next
'#################### THIS IS THE CLASS FOR BING NEXT PAGE ################
Set nextPageElements = HTMLdoc.getElementsByClassName("sb_pagN sb_pagN_bp b_widePag sb_bp")(0)
If nextPageElements 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))
'######################## NO LONGER GOING TO NEXT PAGE ######################
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
''' Delete duplicates
Sheet2.Columns("A").RemoveDuplicates Columns:=Array(1), Header:=xlYes
pageNumber = pageNumber + 1
'######################### LOOP COUNTER ######################
myCounter = myCounter + 1
Worksheets("Sheet10").Range("G6").Value = myCounter
Loop
''' Delete Row If Blank
Sheet2.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
'################################# ISSUE END HERE ############################
'#############################################################################
If Sheet10.Range("I17") = 0 Then
Complete.Show
Termination.Hide
ElseIf Sheet10.Range("I17") > 0 Then
Complete.Show
End If
ie.Quit
Set ie = Nothing
Set HTMLdoc = Nothing
Set nextPageElements = Nothing
Set li = Nothing
Set link = Nothing
End Sub
来源：https://stackoverflow.com/questions/62558446/bing-scraper-navigation