在某些循环结束之前，无法使我的脚本处理错误

Question

我已经在vba中编写了一个脚本来刮取在发出代理请求时填充的ip地址。我在我的vba脚本中使用了代理（代理列表）来测试（可能这些都没有在这个时候工作）。

但是，我想要实现的是，当请求失败时，以下脚本将打印该错误消息并继续执行下一个请求，否则它将解析该站点的IP地址并继续运行直到循环耗尽。

到目前为止我的尝试（认为proxyList是工作的）：

Sub ValidateProxies()
    Dim Http As New ServerXMLHTTP60, elem As Object, S$
    Dim proxyList As Variant, oProxy As Variant

    proxyList = [{"98.163.59.8:8080","134.209.115.223:3128","191.101.233.198:3129","198.177.126.218:80","35.185.201.225:8080"}]

    For Each oProxy In proxyList
        On Error Resume Next
        With Http
            .Open "GET", "https://www.myip.com/", False
            .setRequestHeader "User-Agent", "Mozilla/5.0"
            .setProxy 2, oProxy
            .send
        End With
        On Error GoTo 0

        If Err.Number <> 0 Then
            Debug.Print "Encountered an error"

        Else:
            With New HTMLDocument
                .body.innerHTML = Http.responseText
                Set elem = .querySelector("#ip")
                R = R + 1: Cells(R, 1) = oProxy
                Cells(R, 2) = elem.innerText
            End With
        End If
    Next oProxy
End Sub

如果有脚本打印出任何错误，如何继续滚动直到循环结束？

Answer 1

这将打印遇到的所有错误，您应该通过err.Number进行定制

Option Explicit
Public Sub ValidateProxies()
    Dim http As New ServerXMLHTTP60, elem As Object, S$
    Dim proxyList As Variant, oProxy As Variant, r As Long
    Dim html As HTMLDocument
    Set html = New HTMLDocument
    proxyList = [{"98.163.59.8:8080","134.209.115.223:3128","191.101.233.198:3129","198.177.126.218:80","35.185.201.225:8080"}]

    For Each oProxy In proxyList
        On Error GoTo errhand:
        With http
            .Open "GET", "https://www.myip.com/", False
            .setRequestHeader "User-Agent", "Mozilla/5.0"
            .SetProxy 2, oProxy
            .send
            With html
                .body.innerHTML = http.responseText
                Set elem = .querySelector("#ip")
                r = r + 1: ActiveSheet.Cells(r, 1) = oProxy
                ActiveSheet.Cells(r, 2) = elem.innerText
            End With
        End With
    Next oProxy
    Exit Sub

errhand:
    If Err.Number <> 0 Then
        Debug.Print "Encountered an error " & Err.Description, oProxy
        Err.Clear
        Resume Next
    End If

End Sub

Answer 2

以下是将异步请求池和日志记录状态和错误记录到工作表的示例。它使用free-proxy-list.net的代理列表。

Option Explicit

Sub TestProxy()

    Const PoolCapacity = 50
    Const ReqTimeout = 15

    Dim sResp
    Dim aProxyList
    Dim oMatch
    Dim oWS
    Dim lIndex
    Dim ocPool
    Dim i
    Dim sResult
    Dim oReq

    ' Parsing proxy list from free-proxy-list.net
    With CreateObject("MSXML2.ServerXMLHTTP.6.0")
        .Open "GET", "https://free-proxy-list.net/", True
        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64)"
        .Send
        Do Until .ReadyState = 4: DoEvents: Loop
        sResp = .ResponseText
    End With
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "<td[^>]*>(\d+\.\d+\.\d+\.\d+)<\/td><td[^>]*>(\d+)<\/td>"
        aProxyList = Array()
        For Each oMatch In .Execute(sResp)
            ReDim Preserve aProxyList(UBound(aProxyList) + 1)
            aProxyList(UBound(aProxyList)) = oMatch.SubMatches(0) & ":" & oMatch.SubMatches(1)
        Next
    End With
    ' Proxy checking with api.myip.com requests
    Set oWS = ThisWorkbook.Sheets(1)
    oWS.Cells.Delete
    Set ocPool = New Collection
    lIndex = 0
    Do
        ' Check pool for completed requests
        For i = ocPool.Count To 1 Step -1
            On Error Resume Next
            sResult = ""
            With ocPool(i)(0)
                Select Case True
                    Case .ReadyState < 4
                    Case .Status \ 100 <> 2
                        sResult = "Status " & .Status & " / " & .StatusText
                    Case Else
                        sResult = .ResponseText
                End Select
            End With
            Select Case True
                Case Err.Number <> 0
                    sResult = "Error " & Err.Number & " / " & Err.Description
                Case (Now - ocPool(i)(1)) * 86400 > ReqTimeout
                    sResult = "Timeout"
            End Select
            On Error GoTo 0
            If sResult <> "" Then
                oWS.Cells(ocPool(i)(2), 2).Value = sResult
                ocPool.Remove i
            End If
            DoEvents
        Next
        ' Add new request to pool
        If ocPool.Count < PoolCapacity And lIndex <= UBound(aProxyList) Then
            Set oReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
            With oWS.Cells(lIndex + 1, 1)
                .Value = aProxyList(lIndex)
                .Select
            End With
            With oReq
                .Open "GET", "https://api.myip.com/", True
                .SetProxy 2, aProxyList(lIndex)
                .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64)"
                .Send
            End With
            ocPool.Add Array( _
                oReq, _
                Now, _
                lIndex + 1 _
            )
            lIndex = lIndex + 1
            DoEvents
        End If
    Loop While ocPool.Count > 0
    MsgBox "Completed"

End Sub