VBA宏只能部分运行一次

时间:2019-06-11 13:10:20

标签: html excel vba registry

我修改了我在网上找到的代码,以便能够在HTML页面上找到ClassName并在执行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

0 个答案:

没有答案