QueryTable with BackgroundQuery in Excel

pauloaguia
pauloaguia used Ask the Experts™
on
Here's the story:

I have an Excel document that generates reports from a DB's contents. I have a form that collects the report parameters and that on the click of a button generates the report.

However the DB contents are huge and I also have a Cancel button to stop the report if at some point it's obvious it's going to take too long to generate...

I coded the Cancel button just fine. But if I hit it during the execution of one of the queries it just wouldn't Cancel until the query finished (which could be up to 5 min).

"Easy" - I thought - " just turn it into a background query so you can cancel it during execution". However the Refreshing property of the QueryTable doesn't seem to change until I hit Ctrl+Break to Debug the code and see why the query never finishes execution.

You can check this for yourselves: Just paste the following code on the ThisWorkbook module of a new workbook and change the query to one that will work on a DB of yours and hit F5 (since the ODBC connect string is incomplete it will prompt you to choose the ODBC connection)

---8<---8<---8<---
Sub fillin()
    Dim qt As QueryTable
    Set qt = Application.ActiveSheet.QueryTables.Add("ODBC;", Range("A1"), "SELECT * FROM tabela")
    qt.BackgroundQuery = True
    qt.FieldNames = True
    qt.Refresh
   
    Do While qt.Refreshing
        DoEvents
    Loop
End Sub
---8<---8<---8<---

Even for a query that should last a second, it will be stuck... Hit Ctrl+Break to debug and "magically" the refreshing property goes to False and you'll get out of the loop...

By the way: I'm using the DoEvents method inside the loop since I need to capture the Click event on the Cancel Button. I've also tried adding a "Wait 1 sec" inside the loop but the result is the same.

What am I doing wrong here? And why is the Refreshing property behaving like that? What's the way to accomplish this task? I've looked everywhere but I've found nothing on the subject...
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®

Commented:
Forget about QueryTable.
use thist function:

Public Function XLOut(sql As String, Optional WS As Worksheet = Nothing, Optional ByRef x As Long = 1, Optional ByRef y As Long = 1, Optional ByRef n As Long = 1, Optional ByRef m As Long = 1, Optional Headers As Boolean = True) As Worksheet
'Turbo Version
    Dim a As Variant
    Dim rs As New ADODB.Recordset
    Dim con As New ADODB.Connection
    Dim ors As Recordset
    'Dim l, i, j As Integer
    Dim c() As Variant
    Dim i, j, l, k As Integer
   
    rs.Open sql, "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & CurrentDb.Name & ";", adOpenForwardOnly, adLockOptimistic
   
    a = rs.GetRows()
   
    ReDim c(UBound(a, 2), UBound(a, 1))
   
   
    For k = 0 To UBound(a, 1) 'ñòðîêè
    For j = 0 To UBound(a, 2) 'ïîëÿ
        c(j, k) = a(k, j)
    Next j
    Next k
   
    n = UBound(a, 2) + 1
    m = UBound(a, 1) + 1
   
    WS.Range(WS.Cells(y, x), WS.Cells(n + y - 1, m + x - 1)) = c
   
    'çäåñü, åñëè íóæíî, ðèñóåì çàãîëîâêè
    If Headers Then
        WS.Range(WS.Cells(y, x), WS.Cells(n + y - 1, m + x - 1)).rows(1).Insert
        For j = 0 To m - 1
            WS.Cells(y, j + x).Value = rs.Fields(j).Name
        Next j
    End If
   
    rs.Close
   
    'óñå...
    Exit Function
whoops:
    Resume Next

End Function


Email me notmyname on mail.ru for comments.

Author

Commented:
Zmey2,
I have a few problems with your function:

* This doesn't seem to perform an asynchronous connection. That's the reason I got in this in the first place. If I'm not mistaken that's just a question of setting an option when opening the recordset (I'll find that out)
* I suppose your comments are in russian because here they appear all messed up (nevertheless I understood it fine without them)
* I will loose some of the properties of the querytable like filtering or sorting on different fields on the fly. Which is one of the reasons I'm using it as well.
* You have optional parameters (Like WS) that you set to nothing as default but then just use them as if they were set...

I will however try to fit this into my code and if I have any success I'll let you know.



For everybody else, please, feel free to post some different solution.

Commented:
Well, i'll explain a little bit:

Comments in Russian, sorry for that, but i thought it's quite easy to understand.

You can sort and filter your table in sql string using WHERE and ORDER BY clause.

Well, WS is a worksheet you should create before put data in it.

I recommend this function just cause it's the fastest way to put data from access to excel and you can test this.

Best regards,
Zmey2.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Commented:
Well, i'll explain a little bit:

Comments in Russian, sorry for that, but i thought it's quite easy to understand.

You can sort and filter your table in sql string using WHERE and ORDER BY clause.

Well, WS is a worksheet you should create before put data in it.

I recommend this function just cause it's the fastest way to put data from access to excel and you can test this.

Best regards,
Zmey2.

Author

Commented:
I understood the code... I was just teasing you about the comments. :)

And I know that I can sort using ORDER BY and filter using WHERE. But that's when I run the query. QueryTables offer me the opportunity to filter and sort data on the fly only in Excel without having to requery (up to a 5 min query, don't forget) all the data again.

Nevertheless I'm trying it... I may have some comments on my results by tomorrow (or Monday, since we're approaching the weekend)

Commented:
Wish you a good luck, pauloaguia.

Author

Commented:
Here's an update on my progress:

I needed to tweak your function a bit. I don't know what version of ADO you are using but I'm stuck with ADO 3.51 (it's one of the requirements. I still haven't figured out why, but I need to live with it). Anyway in that version there's no Open method for the recordset so I had to create a QueryDef to open it...

The QueryTable methods I used the most during the report generation were the FetchedRowOverflow (to check if I had "run out" of worksheet to put the results in) and the ResultRange. I can mimic the latter by making the funtion return a Range (I wouldn't need it to return a worksheet anyway). This also solves a weird problem I had because querytable's resultrange allways has a minimum of 3 rows (even if empty ones).
As to the FetchedRowOverflow (which if achieved would halt the execution) I will think of something (probably return Nothing and check the return value. Still need to think on this one to allow me to find the difference between an empty query and an overfull one).

It turned out I wasn't using a querytable when I filtered results but a PivotTable based on a querytable (with a few more columns on the side).

I also needed to open the recordset as an asynchronous one. This was easy since it's one of the options of the OpenRecordset method. Then do a cycle waiting for it to stop refreshing (with a wait of 1 sec and a DoEvents in the inside). It worked fine.

Instead of passing a worksheet and coordinates, I just pass a range representing the destination's UpperLeft corner. It's what I pass to a querytable and I don't have to change that much code in the process.

You were right about this method being faster. For a relatively simple query this method took me about 15% less time to complete. I must admit I had my doubts because of that matrix transposition but numbers don't lie :)


Now I have basically two problems:

* I'm almost at the end of the project. The application involves not one but a dozen of reports, each one using two to three querytables (which are used sparsely in the code). I'll have to recode most of it (but a man's gotta do what a man's gotta do).

* Currently my Cancel button was setting a flag in the module (each module for a report) that indicated whether execution had been halted or not. However now I'm going to add this function to a common module where I keep a few shared methods. So I won't know which of the flags to check to cancel the loop if someone hits the Cancel button..
Actually, now that I think about it I think I could pass a reference to the Form that is getting the input from the user (I have one Form per report) and make this flag a property of the form... Here's an idea to look into more carefully...

Nevertheless I will have a long recoding job ahead (which should take me a couple of days to finish). I'll get on to it and when I'm done I'll post the finished version of the function for the records.
I'd also like to wait for that event to happen to close this question just in case I find some other dificulty I can't think of right now and that will make me want to stick to querytables.

So Zmey2 your well deserved points will have to wait a little bit :)


And if anybody else is still following this thread I'm still curious as to if it is possible to accomplish this task using only querytables. I would award some extra points for the person that would come up with that solution too...
Commented:
Hi,  pauloaguia !

I worked this function for my purposes - which were to fast put various querys from access to Excel. For getting number of rows and columns read i use byref n and m, for specifying top left corner - x and y.

If you have troubles with ADO you can change it for DAO, but there are two problems - first it's a little slower, second - if you have a mistake in DAO recordset (like DIV/0) the GetRows method will work until that row and give you no error message - you'll just lose data.

Another fast method i would advise, is formatting your cells using autofilter method. In short you select range, put autofilter to it and apply format.

Best wishes,
(wayting eagerly for my points :)
Zmey2.

Author

Commented:
Sorry for the late response but apparently there's something wrong with e-mail notification (which means I don't know when you'll get this either :) )

I've tryed using ADO at first. But the thing is that in ADO the termination of an assynchronous query is flaged by an event and not a property. Which would imply that it would have to be an event that triggered the exit of the loop. Not to mention the fact htat I would still need to learn I to catch that event (all exemples I see are allways in C, I haven't found a single one in VB)

With DAO (by the way I'm using DAO 3.51 and not ADO 3.51 as I stated earlier... I switched the two characters by accident) I can check on this by using the StillExecuting property. However I'm having some problems with it also since after a while (for some of those really long queries) the checking upon the flag raises an error number 63535 "ODBC - call failed" (the query is correct. It runs on the Sql Worksheet. And it executes. The thing is, when Oracle finally decides to finish the query, the StillExecuting call fails all of a sudden).

In this scenario I'm wondering if you have or can find any VB (preferably VBA) example using and checking for an asynchronous connection in ADO.
Or do you have any ideas as to what may be happening to make the ODBC call fail in DAO?

After all asynchronism is the heart of this question.

Author

Commented:
Never mind. I found the State property (in MSDN it just says to watch the event doesn't say that you can check the state too).

Thanks for your help and Happy New Year (I'm so happy I could finish this just before the end of the year :)  )

I'll post the complete function here:

'It receives a form as an argument because the form has the Canceled flag stating if the Cancel button has been pressed or not.
Public Function Query(Sql As String, ConnectionString As String, Destination As Range, Optional Headers As Boolean = True, Optional ByRef Form As Object = Nothing) As Range
    Dim a As Variant
    Dim rs As ADODB.Recordset
    Dim conn As ADODB.Connection
    Dim c() As Variant
    Dim j, k As Long
    Dim lngOptions As Long
   
    Set conn = New ADODB.Connection
    conn.Open ConnectionString
    Select Case ConnectionString
    Case ThisWorkbook.strConnection
        lngOptions = adAsyncConnect   'Oracle DB. Should connect asynchronously
    Case ThisWorkbook.strConnectionConfig
        lngOptions = -1  'Access DB. Only supports synchronous connections
    End Select
   
    Set rs = conn.Execute(CommandText:=Sql, Options:=lngOptions)
   
    Do While rs.State = adStateConnecting Or rs.State = adStateExecuting Or rs.State = adStateFetching
        Application.Wait Now + TimeValue("00:00:01")
        DoEvents
       
        If Not Form Is Nothing Then
            If Form.Canceled Then
                rs.Cancel
                conn.Close
                Set conn = Nothing
                Set Query = Nothing  'If canceled doesn't really matter what it returns
                Exit Function
            End If
        End If
    Loop

    If rs.EOF Then
        rs.Close
        conn.Close
        Set conn = Nothing
        Set Query = Destination  'Empty recordset. Return original destination cell only
        Exit Function
    End If
   
   
    a = rs.GetRows(65537)
   
    If UBound(a, 2) + 1 = 65537 Then
        'If it doesn't fit on a worksheet
        rs.Close
        conn.Close
        Set conn = Nothing
        Set Query = Nothing
        Exit Function
    End If
   
    If Not rs.EOF Then  'should be at EOF since all records were alegedely retrieved. If not an error as ocurred
        rs.Close
        conn.Close
        Set conn = Nothing
        Set Query = Nothing
        Err.Raise vbObjectError + 1, "", "Ocorreu um erro ao tentar aceder à base de dados.", "", 0
    End If
   
    ReDim c(UBound(a, 2), UBound(a, 1))
   
    For k = 0 To UBound(a, 1)
    For j = 0 To UBound(a, 2)
        c(j, k) = Trim(a(k, j))
    Next j
    Next k
   
    Destination.Worksheet.Range(Destination, Destination.Offset(UBound(a, 2), UBound(a, 1))).Value = c
   
    If Headers Then
        Destination.Worksheet.Range(Destination, Destination.Offset(0, UBound(a, 1))).Insert xlShiftDown
        For j = 0 To UBound(a, 1)
            Destination.Cells(0, j + 1).Value = rs.Fields(j).Name
        Next j
       
        'Return the range with Data and HEaders
        Set Query = Destination.Worksheet.Range(Destination.Offset(-1, 0), Destination.Offset(UBound(a, 2), UBound(a, 1)))
    Else
        'Return the range with Data
        Set Query = Destination.Worksheet.Range(Destination, Destination.Offset(UBound(a, 2), UBound(a, 1)))
    End If
   
    rs.Close
    conn.Close
    Set conn = Nothing
End Function

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