Страницы: 1
RSS
Обработка ошибок VBA. Не получается выполнить ошибочный код повторно и обработать ошибки
 
Здравствуйте!
Подскажите пожалуйста, столкнулся со сложностью отработать в цикле ошибочный запрос, который делается в поверквери.

Смысл логики:
1 - Запускаем средствами VBA запрос PowerQuery
2 - В случае выполнения кода нормально идем дальше.
3 - В случае если запрос не выполнился через кнопку Да/Нет запрашиваем повторную возможность выполнить запрос PowerQuery
4 - Если кнопку нажали Да - делаем повторный запрос PowerQuery ловим ошибку - Если кнопку нашали НЕТ очищаемся и выходим из бесконечного цикла.

Суть проблемы:
Первый раз ошибка обрабатывается нормально, мы переходим в обработчик ошибки, если нажимаем повторно ДА, то ошибочный запрос PQ не проходит повторно через обработчик ошибок и вываливается в Дебагер.

К чему все это мне нужно.
Мне надо запустить запрос PQ и выгрузить данные на сервер, в PQ запускается обработка которая выгружает данные подготовленные макросом через форму ввода на сервер.
Я точно знаю что сервер 100% времени доступен и надежен, однако могут быть иногда срывы коннекта по вине сети, и это единовременные короткие глюки. Сеть перезагружается автоматически если это происходит, но в течении минуты коннекта с сервером не будет и мне нужно не прерывая цикл и код сделать просто еще одну, может быть 2 или три попытки загрузки данных на сервер, даже если сеть недоступна сейчас через минуту все наладится.
Код приведен ниже, не получается решить проблему, пожалуйста подмогните.
Пробовал бесконечный For, теже яйца, только в профиль.
Первый ErrorHandl работает нормально, далее при повторной попытке дебагер также ругается на ошибку возникающую в запросе PQ
Код
' обработка запроса PQ
StartRefresh:
         On Error GoTo ErrorHandler3
         ' Insert code that might generate an error here
'В модуле запускаем обновление запросов PQ
Module1: Refresh

         ' Exit Sub
ErrorHandler3:
         ' Insert code to handle the error here

                                If Err.Number Then
                                    'Повторный запрос
                                    Dim answer1 As Integer
                                    answer1 = MsgBox("Повторная попытка?", vbQuestion + vbYesNo + vbDefaultButton2, "Повторная попытка?")
                                    If answer1 = vbYes Then
                                        GoTo StartRefresh
                                    Else
                                        GoTo Finish
                                    End If
                                End If
           Resume Next

Finish:
На всякий случай код, по которому происходит обновление запросов powerQuery
Код
Public Sub Refresh()

SnyatZaschituOdinParol

    For Each objConnection In ThisWorkbook.Connections
        'Get current background-refresh value
        bBackground = objConnection.OLEDBConnection.BackgroundQuery
        'Temporarily disable background-refresh
        objConnection.OLEDBConnection.BackgroundQuery = False
        'Refresh this connection
        objConnection.Refresh
        'Set background-refresh value back to original value
        objConnection.OLEDBConnection.BackgroundQuery = bBackground
    Next

    'MsgBox "Finished refreshing all data connections"

PostavitZaschituOdinParol
'UserForm1.Show vbModel

End Sub
 
Господа, даже предположений нет?

1 - Нарушений правил форума?
2 - Неправильно сформулирован вопрос?
3 - Задача не решаемая?
 
Доброе время суток
Цитата
lostandleft написал:
2 - Неправильно сформулирован вопрос?
В некоторой степени. Смысл описания логики не бъёт с кодом. Да и в хитросплетении goto нет желания разбираться.
Я бы так делал (не тестировал - не на чем :) )
Код
Private Type RefreshResultType
    Message As String
    Success As Boolean
End Type
Public Sub RefreshAllOleDbConnections()
    Dim pConnection As WorkbookConnection
    For Each pConnection In ThisWorkbook.Connections
        If pConnection.Type = xlConnectionTypeOLEDB Then
            RefreshOleDbConnection pConnection.OLEDBConnection
        End If
    Next
End Sub

Private Sub RefreshOleDbConnection(ByVal thisConnection As OLEDBConnection)
    Dim result As RefreshResultType
    result = TryRefreshOleDbConnection(thisConnection)
    If Not result.Success Then
        If MsgBox("Произошла ошибка: " & result.Message, vbYesNo Or vbQuestion, "Повторим?") = vbYes Then
            RefreshOleDbConnection thisConnection
        End If
    End If
End Sub

Private Function TryRefreshOleDbConnection(ByVal thisConnection As OLEDBConnection) As RefreshResultType
On Error GoTo errHandle:
    Dim storedRefresh As Boolean, result As RefreshResultType
    storedRefresh = thisConnection.BackgroundQuery
    thisConnection.BackgroundQuery = False
    thisConnection.Refresh
    thisConnection.BackgroundQuery = storedRefresh
    result.Success = True
    TryRefreshOleDbConnection = result
Exit Function
errHandle:
    thisConnection.BackgroundQuery = storedRefresh
    result.Message = Err.Description
    result.Success = False
    TryRefreshOleDbConnection = result
End Function
Изменено: Андрей VG - 15.11.2020 16:15:30 (Поправил код)
 
Цитата
lostandleft написал:
Господа, даже предположений нет?
И этот человек жаловался на отсутствие реакции?! :D
 
Цитата
Андрей VG написал:
И этот человек жаловался на отсутствие реакции?!
Андрей, началась рабочая неделя, не могу попробовать код.
Большое спасибо за участие, кроме того, я не до конца понимаю как работает Private Function, есть сложности с восприятием, ранее все запускал через Sub
поэтому сразу же реакции не последовало, в течении недели обязательно дам обратную связь.
Я хотел поковыряться с этим в выходные, но, к сожалению судьба распорядилась иначе.
Изменено: lostandleft - 16.11.2020 12:14:03
Страницы: 1
Наверх