Избегайте блокировки IP-адресов Google при поиске википедии URls - PullRequest
Новая
       5

Избегайте блокировки IP-адресов Google при поиске википедии URls

0 голосов
/ 01 мая 2018

для моей магистерской работы мне нужно получить Wikipedia-URL для списка актеров (около 20 000) sktneer помог мне с моей первой попыткой запустить код. Еще раз спасибо! (см .: Получить URL страницы Википедии из списка Excel )

Осталась еще одна проблема - Google блокирует мои запросы после пары актеров. (150-200) Идея заключалась в том, чтобы встроить команду Application.Wait в код, чтобы перед каждым новым запросом была пауза в 2-3 секунды.

Будет ли это работать, и если, не могли бы вы помочь мне включить это в код?

Или это неправильный путь и есть ли более простое решение?

образец

Код: 

Sub XMLHTTP()
Dim url As String, lastRow As Long

Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
Dim start_time As Date
Dim end_time As Date
Dim i As Long
Dim str_text As String

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

Dim cookie As String
Dim result_cookie As String

start_time = Time
Debug.Print "start_time:" & start_time

For i = 2 To lastRow

    url = "https://www.google.de/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
    XMLHTTP.send

    If XMLHTTP.Status = 200 Then
        Set html = CreateObject("htmlfile")
        html.body.innerHTML = XMLHTTP.ResponseText
        Set objResultDiv = html.getelementbyid("rso")

        If Not objResultDiv Is Nothing Then
            Set objH3 = objResultDiv.getelementsbytagname("H3")(0)
            Set link = objH3.getelementsbytagname("a")(0)


            str_text = Replace(link.innerHTML, "<EM>", "")
            str_text = Replace(str_text, "</EM>", "")

            Cells(i, 2) = str_text
            Cells(i, 3) = link.href
            DoEvents
        Else
            Cells(i, 2) = "Not Found"
            Cells(i, 3) = "Not Found"
        End If
    Else
        Cells(i, 2) = "Not Found"
        Cells(i, 3) = "Not Found"
    End If
Next

end_time = Time
Debug.Print "end_time:" & end_time

Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
End Sub
...