Обход гиперссылки / тайм-аута с помощью обработчика ошибок

Question

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

Я попытался создать обработчик ошибок, который сбрасывает ошибку и затем продолжается сверху после ожидания 5 секунд. Я пробовал две вещи:

1. Далее при ошибке возобновить, чтобы пропустить эту строку. Кажется, это ничего не делает, поскольку время ожидания кода все еще истекает.

2. Go в обработчик ошибок, подождите 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 = история

https://query1.finance.yahoo.com/v7/finance/download/ ^ NZ50? period1 = 946684800 & period2 = 9999999999 & interval = 1d & events = история

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. Вам нужна стратегия выхода, чтобы избежать возможности бесконечного l oop. Я лично использовал бы go со стратегией максимального числа повторений перед переходом на следующий URL, а также ожидал бы каждые x запросов, чтобы быть хорошим пользователем сети
7. Обычно избегайте эффекта спагетти-кода GoTo
8. Объявите все свои переменные с их типом. Удалите, если не используется. Используйте Option Explicit, чтобы применить

Обычно:

Мне не нравится GoTos, так как это затрудняет чтение и отладку кода. См. Возможность переписывания с дальнейшими комментариями ниже:

TODO:

Рефакторинг кода, чтобы он был менее вложенным с использованием вспомогательных функций / подпрограмм, т.е. был более модульным.

Код:

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