無法使腳本異步等待一段時間以解析標題，然后再進行下一個 url

Question

我正在嘗試使用ServerXMLHTTP60在vba中創建一個腳本，以從一些相同的鏈接解析第一篇文章的標題。 我的主要目標是使腳本異步，同時設置腳本在執行下一個 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？

Answer 1

我不知道為什么這些 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