Макрос Excel выполняется только до ~ 60-й строки, а затем не работает - PullRequest
0 голосов
/ 12 июня 2019

Я изменил код, который нашел в Интернете, чтобы найти ClassName на странице HTML и возвращать его текст при выполнении поиска Google.Мне нужно сделать это примерно для 10 000 компаний, но при тестировании только с 100 строками он работает, а затем останавливается на ~ 60-й строке.После этого я не могу получить никаких результатов и нашел единственный способ решить эту проблему - подождать около часа, а затем выполнить его снова.Я проверил это на другом компьютере и получил те же результаты и проблемы.Это не имеет отношения к тому, что находится в ~ 60-й строке, потому что я использую разный набор из 100 компаний в каждом тесте.Даже изменение цикла с i = 2 на 101 все еще вызывает у него ту же проблему.

Col A будет иметь название компании, такое как: "Buchart Horn"

Col B возвращает "Architectв Балтиморе, штат Мэриленд "

Col C будет пустым (это нормально)

Col D возвращает" Балтимор, штат Мэриленд - Рог Бухарта: инженеры, архитекторы и проектировщики "

IЯ очень новичок в VBA, поэтому любая помощь будет оценена.Спасибо.

'References enabled: 
'Microsoft Internet Controls, Microsoft HTML Object Library

Sub GoogleSearch()
Dim URL As String
Dim objHTTP As Object
Dim htmlDoc As HTMLDocument

Set htmlDoc = CreateObject("htmlfile")

Dim objResults1 As Object
Dim objResults2 As Object
Dim objResults3 As Object

On Error Resume Next

lastRow = Range("A" & Rows.count).End(xlUp).Row

For I = 2 To lastRow

URL = "https://www.google.com/search?q=" & Cells(I, 1)

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

With objHTTP
.Open "GET", URL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send
htmlDoc.body.innerHTML = .responseText

End With

Set objResults1 = htmlDoc.getElementsByClassName("YhemCb")
Set objResults2 = htmlDoc.getElementsByClassName("wwUB2c kno-fb-ctx")
Set objResults3 = htmlDoc.getElementsByClassName("LC20lb")

Cells(I, 2) = objResults1(0).innerText
Cells(I, 3) = objResults2(0).innerText
Cells(I, 4) = objResults3(0).innerText

Next

Set htmlDoc = Nothing
Set objResults1 = Nothing
Set objResults2 = Nothing
Set objResults3 = Nothing
Set objHTTP = Nothing

End Sub

1 Ответ

0 голосов
/ 12 июня 2019

Проблема оказалась в том, что слишком много запросов слишком быстро отправлялись в Google, используя приведенный ниже запрос GET в цикле For:

With objHTTP
.Open "GET", URL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send
htmlDoc.body.innerHTML = .responseText

End With

Для того, чтобы выполнить этот запрос кода в приемлемом темпе для серверамы просим от нас добавить паузу в цикл.

Самый простой встроенный способ сделать паузу в VBA - это:

For I = 2 To lastRow
... 'Lines omitted for clarity of purpose
...
Application.Wait (Now + TimeValue("0:00:6"))
Next

Затем приложение будет ждать до тех пор, пока не продолжится выполнение.(досадное ограничение этого метода - 1 секунда - это минимальное время ожидания, поэтому для меньших значений потребуется другое решение, Application.Wait и примеры, которые могут создать меньшую задержку, обозначенную Здесь )

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