So I've made a sub which creates a new workbook, and executes Mashup (PowerQuery code) within it:
Public Sub ExecuteM(ByVal mCode As String)
Dim wb As Workbook: Set wb = Workbooks.add()
Dim query As WorkbookQuery: Set query = wb.Queries.add("PQ", mCode)
Dim ws As Worksheet: Set ws = wb.Sheets(1)
Dim lo As ListObject: Set lo = ws.ListObjects.add(xlSrcQuery, "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=PQ;Extended Properties=""""", Destination:=ws.Range("A1"))
Dim qt As QueryTable: Set qt = lo.QueryTable
qt.CommandType = xlCmdSql
qt.CommandText = Array("SELECT * FROM [PQ]")
'Refresh async...
Call qt.Refresh(True)
'The data will never populate...
While qt.Refreshing
DoEvents
Wend
End Sub
The problem with the above code is it will never actually resolve... For instance, let's run a simple example:
Sub testM()
Call ExecuteM("#table({""a"",""b""},{{1,2},{3,4}})")
End Sub
If you run the macro, you will see a workbook is created, the list object is created and claims it's loading the data. However it will not actually load the data until VBA runtime is aborted or VBE debug mode is entered.
So the question is, is there a way to force Excel to load data to the sheet? Or better still, is there a means that we can get at these data without having to load it into excel as a list object?
Demonstration of issue: https://youtu.be/JYRUbWQ8mxk
FYI - This is a simplified example of my code. In reality I've got many simultaneous running fibers using stdFiber
. So async would be really useful here as I can run many queries in parallel. But aborting runtime just isn't really feasible without a rework of stdFiber
and utilising something like StateLossCallback.
One way to do this would be to use .OnTime
to schedule a check (CheckQueryRefreshStatus
) for when the query is refreshed then let VBA stop its execution for enough time to let the query run. The status checking method also needs to call itself with .OnTime
if the query isn't refreshed yet.
Example:
Private qt As QueryTable
Sub testM()
Call ExecuteM("#table({""a"",""b""},{{1,2},{3,4}})")
End Sub
Public Sub ExecuteM(ByVal mCode As String)
Dim wb As Workbook: Set wb = Workbooks.Add()
Dim query As WorkbookQuery: Set query = wb.Queries.Add("PQ", mCode)
Dim ws As Worksheet: Set ws = wb.Sheets(1)
Dim lo As ListObject
Set lo = ws.ListObjects.Add(xlSrcQuery, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=PQ;Extended Properties=""""", _
Destination:=ws.Range("A1"))
Set qt = lo.QueryTable
qt.CommandType = xlCmdSql
qt.CommandText = Array("SELECT * FROM [PQ]")
' Refresh async
Call qt.Refresh(True)
' Use OnTime to check status later
Application.OnTime Now + TimeValue("00:00:01"), "CheckQueryRefreshStatus"
End Sub
Public Sub CheckQueryRefreshStatus()
' If still refreshing, check again in 1 second
If qt.Refreshing Then
Application.OnTime Now + TimeValue("00:00:01"), "CheckQueryRefreshStatus"
Else
MsgBox "Query refresh complete!", vbInformation
End If
End Sub
Inside the if-statement in CheckQueryRefreshStatus
, you can call another sub instead of the MsgBox. The only downside of this approach is that you'd have to define relevant variables at the module-level so that all subs have access to them and you can resume execution with the right context once the query is refreshed.
EDIT1: Since you mentioned that you'd want to run multiple queries in parallel, you could then use a dictionnary to store the name of the query and run them in parallel like so:
Private PendingQueries As Object
Sub testM()
' Initialize the dictionary
Set PendingQueries = CreateObject("Scripting.Dictionary")
' Execute multiple queries in parallel
Call ExecuteM("Query1", "#table({""a"",""b""},{{1,2},{3,4}})")
Call ExecuteM("Query2", "#table({""c"",""d""},{{1,2},{3,4}})")
End Sub
Public Sub ExecuteM(ByVal QueryName As String, ByVal mCode As String)
Dim wb As Workbook: Set wb = Workbooks.Add()
Dim query As WorkbookQuery: Set query = wb.Queries.Add("PQ", mCode)
Dim ws As Worksheet: Set ws = wb.Sheets(1)
Dim lo As ListObject
Set lo = ws.ListObjects.Add(xlSrcQuery, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=PQ;Extended Properties=""""", _
Destination:=ws.Range("A1"))
Dim qt As QueryTable
Set qt = lo.QueryTable
qt.CommandType = xlCmdSql
qt.CommandText = Array("SELECT * FROM [PQ]")
' Store query in the dictionary
PendingQueries.Add QueryName, qt
' Refresh asynchronously
Call qt.Refresh(True)
' Start monitoring queries if not already running
If PendingQueries.Count = 1 Then
Application.OnTime Now + TimeValue("00:00:01"), "CheckQueriesRefreshStatus"
End If
End Sub
Public Sub CheckQueriesRefreshStatus()
Dim i As Integer
Dim qt As QueryTable
Dim keysToRemove As Collection
Set keysToRemove = New Collection
' Check all queries in the dictionary
Dim Key As Variant
For Each Key In PendingQueries.Keys
Set qt = PendingQueries(Key)
If Not qt.Refreshing Then
' Mark this query for removal
keysToRemove.Add Key
End If
Next Key
' Remove completed queries
For i = 1 To keysToRemove.Count
MsgBox keysToRemove(i) & " refresh complete!", vbInformation
PendingQueries.Remove keysToRemove(i)
Next i
' If there are still queries running, check again in 1 second
If PendingQueries.Count > 0 Then
Application.OnTime Now + TimeValue("00:00:01"), "CheckQueriesRefreshStatus"
Else
MsgBox "All queries have finished refreshing!", vbInformation
End If
End Sub
Here, CheckQueriesRefreshStatus
is looking at all the queries stored in PendingQueries
at the same time and is waiting for Excel to complete them all in parallel.
EDIT2: And if you really don't want to stop VBA's execution, the only way I can think of is to create another Excel Application to perform the query in parallel like below (I also added some Sleep to the loop to make it more efficient, but that remains optional).
'Declare the Sleep() method from the Windows API
#If VBA7 Then ' Excel 2010 or later
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else ' Excel 2007 or earlier
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Sub testM()
Call ExecuteM("#table({""a"",""b""},{{1,2},{3,4}})")
End Sub
Public Sub ExecuteM(ByVal mCode As String)
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.WindowState = xlMaximized
Dim wb As Workbook: Set wb = xlApp.Workbooks.Add()
Dim query As WorkbookQuery: Set query = wb.Queries.Add("PQ", mCode)
Dim ws As Worksheet: Set ws = wb.Sheets(1)
Dim lo As ListObject: Set lo = ws.ListObjects.Add(xlSrcQuery, "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=PQ;Extended Properties=""""", Destination:=ws.Range("A1"))
Dim qt As QueryTable: Set qt = lo.QueryTable
qt.CommandType = xlCmdSql
qt.CommandText = Array("SELECT * FROM [PQ]")
'Refresh async...
Call qt.Refresh(True)
'The data will populate
While qt.Refreshing
DoEvents
Sleep 200
Wend
Set xlApp = Nothing
End Sub