How to catch SQL: Data Source Error with VBA?

Member_2_8198715
Member_2_8198715 used Ask the Experts™
on
Hello everyone,

This is my first post, so sorry if anything is wrong. I work on a project where I create a report that is based on data from two different databases and local Excel tables. Both databases are from different third party software's. I can access one database via power query and I export Excel reports from the other one. My report consist of five different sheets, each sheet needs special formatting and calculations. I need over 20 different queries to get all necessary data. Many different queries access the same tables and the third party software is also blocking tables sometimes, therefore I can get the following error:

1004 [DataSource.Error] Microsoft SQL: Transaction (Process ID 302) was deadlocked on lock resources with another process and has been chosen as the deadlock victim. Rerun the transaction.

Open in new window


To get around these issues I programmed VBA code to refresh the queries in batches, that they don't interfere each other and I added an error handler to catch the error and rerun the code till it's successfully refreshed. I tested this code with two simple queries on a database table and it worked perfectly. It caught the errors and always refreshed everything. After I added one of my production queries, which consist of two database tables and two local Excel tables, I rerun the code and for a reason I can't figure out, the Datasource Error is not caught anymore and stops my program. See attached

The next day I tried a different approach. I copied the working file and created the queries on the database separately. So Query 1 and Query 2 are now merging together as a new query 3 and after that I  create all my custom columns and merge with the local tables. But that didn't work, same error. After that I created two queries on the database where I just selected the columns that I need and nothing else. I loaded these queries to the Excel file and queried than from these tables again. I thought I could avoid with that solution any interference's, because Excel is only connecting two times to the database. The idea was inspired by this post: https://community.powerbi.com/t5/Desktop/Staging-query-is-getting-executed-for-every-sub-query/td-p/463728
But this also didn't work. The two queries are identical to the working ones but they still throw errors that I can't catch. I am slowly running out of ideas here.
Any help would be really appreciated, because I am actually deadlocked with this problem. This is my code for the refresh Batches. Please excuse the weird names, but these are my test names and because I was really desperate I changed everything back how it was when it worked.

=========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"
'    reports.Add "Areas_Comparison_To_Target"
'    reports.Add "Hours_Comparison"
'    reports.Add "Holidays"
'
    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

    printReports

    createBatches
    batchInd = 1
    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 "People", 1
'                myQueries.Add "Areas", 1
'                myQueries.Add "RbPData", 2
                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

'        Dim tester As Test24
'        Set tester = New Test24
        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

Open in new window

Annotation-2019-01-30-155439.jpg
QueryRefresh_Testing.xlsm
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Raja Jegan RSQL Server DBA & Architect, EE Solution Guide
Awarded 2009
Distinguished Expert 2018

Commented:
I work on a project where I create a report that is based on data from two different databases and local Excel tables
My report consist of five different sheets, each sheet needs special formatting and calculations. I need over 20 different queries to get all necessary data.

Since you are joining data across 2 different databases and local Excel tables, just wondering if you can insert all required data across all your data sources and place it in a local SQL Server instance(may be express edition) and then run all your 20 different queries on your static tables to avoid all these issues..

>> Many different queries access the same tables and the third party software is also blocking tables sometimes, therefore I can get the following error:

If you are going to just SELECT historical data, then try to use NOLOCK hint which can help avoid the deadlock scenario..
Hope your report doesn't have real time data, if no then it shouldn't have any potential issues with uncommitted data..

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial