Макрос VBA может работать только один раз - PullRequest
0 голосов
/ 11 июня 2019

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

Я очень плохо знаком с VBA, поэтому любая помощь будет принята с благодарностью.Спасибо.

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

Set htmlDoc = CreateObject("htmlfile")
'Set htmlDoc = New HTMLDocument

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...