Не удается отследить тупиковую ошибку запросов Power Query к базе данных SQL с VBA, если запрос состоит из нескольких объединенных запросов

Question

Это мой первый пост, заранее извиняюсь за любые ошибки.Я работаю над проектом, в котором я создаю отчет, основанный на данных из двух разных баз данных и локальных таблиц Excel.Обе базы данных взяты из разных сторонних программ.Я могу получить доступ к одной базе данных, которая является базой данных SQL, работающей на Microsoft SQL Server 2008, с помощью запроса мощности, и я экспортирую отчеты Excel из другой.Мой отчет состоит из пяти различных листов, каждый из которых требует специального форматирования и расчетов.Мне нужно более 20 различных запросов, чтобы получить все необходимые данные.Много разных запросов обращаются к одним и тем же таблицам, и стороннее программное обеспечение также иногда блокирует таблицы, поэтому я могу получить следующую ошибку:

1004 [DataSource.Error] Microsoft SQL: транзакция (ID процесса 302)был заблокирован при блокировке ресурсов с другим процессом и был выбран в качестве жертвы тупика.Перезапустите транзакцию.

Чтобы обойти эти проблемы, я запрограммировал код VBA для обновления запросов в пакетах, чтобы они не мешали друг другу, и добавил обработчик ошибок, чтобы перехватить ошибку и повторно запуститькод, пока он не будет успешно обновлен.Я протестировал этот код с двумя простыми запросами к таблице базы данных, и он отлично работал.Он ловил ошибки и всегда все обновлял.После того, как я добавил один из моих производственных запросов, который состоит из двух таблиц базы данных и двух локальных таблиц Excel, я повторно запускаю код, и по причине, по которой я не могу понять, ошибка источника данных больше не перехватывается и останавливает мою программу.

Любая помощь будет очень признательна, потому что я на самом деле зашел в тупик с этой проблемой.Это мой код для обновления пакетов.Прошу прощения за странные имена, но это мои тестовые имена, и, поскольку я был действительно в отчаянии, я изменил все обратно на то, что было, когда это работало.

=========Module4===============

Option Explicit

Sub Test5()

    Dim reports As Collection
    Dim dc As DailyReportC

    Set dc = New DailyReportC
    Set reports = New Collection

    reports.Add "Report_by_Person"
    reports.Add "Report_by_Machine"
    dc.init reports

End Sub

=========Module5===============

Option Explicit

Private refreshed As Boolean
Public caller As refreshBatch

Sub refreshChecker7()

    If Application.CommandBars.GetEnabledMso("RefreshStatus") Then
        Application.OnTime Now + TimeValue("00:00:10"), "refreshChecker7"
    ElseIf refreshed = True Then
        Debug.Print "Test 24 Done Refreshing"
        Debug.Print "----"
        refreshed = False
        caller.refreshTheQueries
    Else
        refreshed = True
        Application.OnTime Now + TimeValue("00:00:05"), "refreshChecker7"
    End If

End Sub

=========Class DailyReportC==============
Option Explicit

Private refreshed As Boolean
Public caller As refreshBatch
Private reports As New Collection
Private batches As New Collection
Private batchInd As Integer


Sub init(givenReports As Collection)

    Set reports = givenReports
    batchInd = 1

    printReports
    createBatches
    runBatch

End Sub

Private Sub createBatches()

    Dim myQueries As Scripting.Dictionary
    Dim report As Variant
    Dim reportName As String

    For Each report In reports
        Set myQueries = New Scripting.Dictionary
        reportName = report
        Select Case reportName
            Case "Report_by_Person"
                myQueries.Add "vTimeBookings", 1
                myQueries.Add "vTimeBookings (2)", 2
                createBatch myQueries, reportName, Me
            Case "Report_by_Machine"
                myQueries.Add "vTimeBookings (2)", 1
                myQueries.Add "vTimeBookings", 2
                myQueries.Add "Areas", 3
                myQueries.Add "Availability_Targets", 3
                createBatch myQueries, reportName, Me
            Case Else
        End Select
    Next report

End Sub

Private Sub createBatch(myQueries As Scripting.Dictionary, reportName As String, dReport As DailyReportC)

    Dim currentRefreshBatch As refreshBatch

    Set currentRefreshBatch = New refreshBatch

    currentRefreshBatch.init myQueries, reportName, dReport
    batches.Add currentRefreshBatch

End Sub

Private Sub printReports()

    Dim report As Variant

    For Each report In reports
        Debug.Print report
    Next report

End Sub

Private Sub runBatch()

    Dim batch As refreshBatch

    If batchInd <= batches.Count Then
        Set batch = batches(batchInd)
        batch.refreshTheQueries
    Else
        Debug.Print "All Reports refreshed"
    End If

End Sub

Public Sub runNextBatch()

    batchInd = batchInd + 1
    runBatch

End Sub

================Class RefreshBatch===============
Option Explicit

Private myQueries As Scripting.Dictionary
Private r_Name As String
Private currentPos As Integer
Private dReport As DailyReportC

Property Get reportName() As String
    reportName = r_Name
End Property

Sub init(givenQueries As Scripting.Dictionary, givenReportName As String, givenDailyReport As DailyReportC)

    Set myQueries = givenQueries
    r_Name = givenReportName
    currentPos = 1
    Set dReport = givenDailyReport

End Sub

Sub refreshTheQueries()

    On Error GoTo ErrHandler

    Dim RefreshQueries() As String
    Dim queryName As Variant
    RefreshQueries = searchQueries()

    If Not Not RefreshQueries Then
        For Each queryName In RefreshQueries
           Debug.Print currentPos, queryName
           ActiveWorkbook.Connections("Query - " & queryName).Refresh
        Next queryName
        currentPos = currentPos + 1
        Set Module5.caller = Me
        Module5.refreshChecker7
    Else
        Debug.Print "Report from " & reportName & " is refreshed"
        Debug.Print "==================="
        dReport.runNextBatch
    End If

Exit Sub

ErrHandler:
    Select Case Err.Number
        Case 1004
            Debug.Print Err.Number, "Refresh Failed", Err.Description
            If currentPos > 1 Then
                currentPos = currentPos - 1
            End If
        Case Else
            Debug.Print Err.Number, "Unexpected Error", Err.Description
    End Select
Resume refreshEnd:

refreshEnd:
    refreshTheQueries

End Sub

Function searchQueries() As Variant

    Dim queryNameList() As String
    Dim tempArr() As String
    Dim firstEntry As Boolean
    Dim i As Long
    Dim arrayPos As Integer
    Dim ind As Integer
    arrayPos = 0
    firstEntry = False

    For i = 0 To myQueries.Count - 1
        If myQueries.Items(i) = currentPos Then
            If firstEntry = False Then
                ReDim queryNameList(0)
                queryNameList(0) = myQueries.Keys(i)
                firstEntry = True
                arrayPos = arrayPos + 1
            Else
                Erase tempArr
                ReDim tempArr(arrayPos)
                For ind = 0 To UBound(queryNameList)
                    tempArr(ind) = queryNameList(ind)
                Next ind
                tempArr(UBound(tempArr)) = myQueries.Keys(i)
                Erase queryNameList
                ReDim queryNameList(arrayPos)
                For ind = 0 To UBound(queryNameList)
                    queryNameList(ind) = tempArr(ind)
                Next ind
            End If
        End If
    Next i

    searchQueries = queryNameList

End Function