Невозможно заставить мой скрипт обрабатывать ошибки, пока не закончится какой-то цикл

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

Вот пример с пулом асинхронных запросов и регистрацией состояний и ошибок на листе. Используется список прокси от 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

Answer 2

Это напечатает все обнаруженные ошибки, и вы должны настроить 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