使用错误处理程序绕过超链接/url超时

Question

我正在编写一些通过 url 打开多个文件的代码。这一切都很好，但是过了一会儿，我从中提取这些数据的服务器阻止了我，这引发了一条错误消息。

我试图做的是创建一个错误处理程序来重置错误，然后在等待 5 秒后从顶部继续。我尝试了两件事

1. 在错误恢复下，跳过该行。这似乎没有任何作用，因为代码仍然超时。

2. 转到错误处理程序，等待 5 秒，重置错误，然后从代码所在的位置继续。

任何想法我做错了什么。下面的示例文件路径；

https://query1.finance.yahoo.com/v7/finance/download/GBPUSD=X?period1=946684800&period2=9999999999&interval=1d&events=history

https://query1.finance.yahoo.com/v7/finance/download/GBPCNY=X?period1=946684800&period2=9999999999&interval=1d&events=history

https://query1.finance.yahoo.com/v7/finance/download/^NZ50?period1=946684800&period2=9999999999&interval=1d&events=histor

Sub TESTING()

Call START

Dim i As Integer

    Workbooks("SHARE PRICE CREATOR.xlsb").Sheets("links").Activate

For i = 2 To Application.WorksheetFunction.CountA(Range("E:E"))

    xtable = Cells(i, 5)
    xURL = Cells(i, 4).Value
    
CONTINUE:
    
    On Error GoTo Errhandle
    Workbooks.Open xURL, FORMAT:=6, DELIMITER:=","
    Workbooks("SHARE PRICE CREATOR.xlsb").Sheets("links").Activate
    Cells(i, 6) = "OK"
    
Next

Errhandle:
    On Error Resume Next
        If Err.Number > 0 Then
            Cells(i, 6) = Err.Number
        End If
    On Error GoTo 0
    Application.Wait (Now + TimeValue("0:00:5"))
    
    GoTo CONTINUE

Call ENDING
    
End Sub

谢谢

斯科特

Answer 1

一些提示：

1. 我认为On Error Resume Next 在您的ErrHandle 中没有任何用途
2. 将Workbooks("SHARE PRICE CREATOR.xlsb").Sheets("links") 放入一个变量中，并以此限定您的范围调用
3. 避免隐含的Activesheet 引用
4. 使用Err.Clear 清除错误
5. 您需要Exit Sub 才能成功完成所有任务，然后才能运行到错误处理程序
6. 您需要一个退出策略来避免无限循环的可能性。我个人会在移动之前采用最大重试策略 到下一个 url 并等待每 x 个请求成为一个好网民
7. 一般避免GoTo的意大利面条码效果
8. 声明所有变量及其类型。如果不使用，请删除。使用Option Explicit 强制执行

一般：

我不喜欢GoTos，因为它使代码难以阅读和调试。在下面查看可能的重写，以及更多的 cmets：

---

待办事项：

使用辅助函数/子代码重构代码以减少嵌套，即更加模块化。

---

代码：

Option Explicit 'Use Option Explicit

Public Sub RetrieveYahooData()

    Const MAX_RETRIES As Long = 3
    Dim i As Long, ws As Worksheet, lastRow As Long 'use Long
    Dim wbMain As Workbook, wb As Workbook, xUrl As String  'declare xUrl
    Dim xtable As String 'temp assignment.
     
    Start 'what subs are these?
    
    Set wbMain = Workbooks("SHARE PRICE CREATOR.xlsb") ''Put in a variable. This assumes is open.
    Set ws = wbMain.Worksheets("links")
    
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row 'You want to count from row 2 I think
    
    If lastRow >= 2 Then
    
        For i = 2 To lastRow
            
            If i Mod 100 = 0 Then Application.Wait Now + TimeSerial(0, 0, 5) 'every n e.g. 100 requests have a pause
            
            numberOfTries = 0
            
            With ws
            
                xtable = .Cells(i, 5).Value      '?What is xTable and its datatype? _
                                                 Declare it and use Option Explicit at top of code. _
                                                 Also, where will it be used?
                xUrl = .Cells(i, 4).Value
                
                If xUrl <> vbNullString Then
                    
                    Do
                    
                        DoEvents
                        
                        On Error Resume Next
                    
                        Set wb = Workbooks.Open(xUrl, Format:=6, DELIMITER:=",") 'add other tests for valid url?
                        
                        On Error GoTo 0
                        
                        If Not wb Is Nothing Then 'remember to save and exit do
                            wb.SaveAs wbMain.Path & "\" & wb.Name, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges 'Credit to @Sorceri https://stackoverflow.com/a/14634781/6241235
                            wb.Close True
                            Exit Do
                        Else
                            Application.Wait Now + TimeSerial(0, 0, 5)
                        End If
                     
                    Loop While numberOfTries < MAX_RETRIES
                    
                End If
    
            End With
            
            ws.Cells(i, 6) = IIf(wb Is Nothing, "FAIL", "OK")
          
            Set wb = Nothing
        Next
    End If
          
    ENDING

End Sub