Не удается заставить скрипт асинхронно ждать определенное время для анализа заголовков перед переходом к следующему URL - PullRequest
Новая
       83

Не удается заставить скрипт асинхронно ждать определенное время для анализа заголовков перед переходом к следующему URL

0 голосов
/ 20 апреля 2020

Я пытаюсь создать скрипт в vba, используя ServerXMLHTTP60, чтобы разобрать заголовок первого поста по некоторым идентичным ссылкам. Моя главная цель - сделать скрипт асинхронным, а также установить максимальное время, до которого скрипт будет пытаться перед переходом к следующему URL.

Однако созданный мной макрос всегда идет к следующему URL, когда есть тайм-аут, не имея возможности очистить заголовки от ссылок. 

Sub FetchContentWithinSpecificTime()
    Dim oHttp As New ServerXMLHTTP60, HTML As New HTMLDocument
    Dim URL As Variant, Urllist As Variant, t As Date, sResp As Boolean

    Urllist = Array( _
        "https://stackoverflow.com/questions/tagged/web-scraping?tab=newest&page=1", _
        "https://stackoverflow.com/questions/tagged/web-scraping?tab=newest&page=2", _
        "https://stackoverflow.com/questions/tagged/web-scraping?tab=newest&page=3", _
        "https://stackoverflow.com/questions/tagged/web-scraping?tab=newest&page=4", _
        "https://stackoverflow.com/questions/tagged/web-scraping?tab=newest&page=5" _
    )

    For Each URL In Urllist
        Debug.Print "trying with: " & URL
        With oHttp
            .Open "GET", URL, True
            .setRequestHeader "User-Agent", "Mozilla/5.0"
            .setTimeouts 5000, 5000, 15000, 15000
            .send
            t = Now + TimeValue("00:00:10")
            sResp = False

            On Error Resume Next
            Do
                If .readyState = 4 Then sResp = True: Exit Do
                If Now > t Then sResp = False: Exit Do
                DoEvents
            Loop
            On Error GoTo 0

            If sResp Then
                HTML.body.innerHTML = .responseText
                Debug.Print HTML.querySelector(".question-hyperlink").innerText
            Else:
                Debug.Print "failed with: " & URL
            End If
        End With
    Next URL
End Sub

Как заставить скрипт ждать определенное время для анализа заголовков, прежде чем перейти для следующего URL?

1 Ответ

0 голосов
/ 21 апреля 2020

Я не знаю, почему эти SO-ссылки требуют много времени для ответа, но я попытался использовать разные URL-адреса, и следующее решение, похоже, работает правильно. Кредит за исправленную часть идет поставщику этого решения . 

Sub FetchContentWithinSpecificTime()
    Dim oHttp As New ServerXMLHTTP60, HTML As New HTMLDocument
    Dim URL As Variant, Urllist As Variant, t As Date
    Dim sPrice$, sResp As Boolean

    Urllist = Array( _
        "https://finance.yahoo.com/quote/NZDUSD=X?p=NZDUSD=X", _
        "https://finance.yahoo.com/quote/FB?p=FB", _
        "https://finance.yahoo.com/quote/AAPL?p=AAPL", _
        "https://finance.yahoo.com/quote/IBM?p=IBM", _
        "https://finance.yahoo.com/quote/UCO?p=UCO" _
    )

    For Each URL In Urllist
        Debug.Print "trying with: " & URL
        With oHttp
            .Open "GET", URL, True
            .setRequestHeader "User-Agent", "Mozilla/5.0"
            .send
            t = Now + TimeValue("00:00:10")
            sResp = False

            Do While .readyState < 4
                If .readyState = 4 Then Exit Do
                sResp = (Now > t) Or (Err.Number <> 0)
                If sResp Then Exit Do
                DoEvents
            Loop

            If Not sResp Then
                HTML.body.innerHTML = .responseText
                sPrice = HTML.querySelector(".Mb\(-4px\)").innerText
                Debug.Print sPrice
            Else:
                Debug.Print "failed with: " & URL
            End If
        End With
    Next URL
End Sub
...