VBA异步执行PowerQuery/M遇数据加载阻塞问题求助

我编写了一个VBA子程序，用于新建工作簿并在其中执行PowerQuery（M语言）代码：

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]")
  
  '异步刷新...
  Call qt.Refresh(True)
  
  '数据始终无法填充...
  While qt.Refreshing
    DoEvents
  Wend
End Sub

运行测试代码后，工作簿和列表对象会创建，显示正在加载数据，但直到终止VBA运行时或进入VBE调试模式，数据才会加载：

Sub testM()
  Call ExecuteM("#table({""a"",""b""},{{1,2},{3,4}})")
End Sub

需求：

• 找到强制Excel将数据加载到工作表的方法
• 或无需将数据加载为列表对象即可获取数据的方式

补充：实际场景中使用stdFiber实现多个并行纤程，异步执行至关重要，无法通过终止运行时解决。

方案1：修复列表对象的异步刷新问题 #

问题核心是死循环式的DoEvents无法释放足够资源让Excel处理PowerQuery后台任务，改用Application.OnTime周期性检查刷新状态，给Excel留足处理空间：

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]")
  
  '启动异步刷新
  qt.Refresh BackgroundQuery:=True
  
  '注册定时检查回调，将QueryTable存入全局变量
  Set g_qt = qt
  Application.OnTime Now + TimeValue("00:00:01"), "CheckRefreshStatus", , True
End Sub

'全局变量存储待检查的QueryTable
Public g_qt As QueryTable

Sub CheckRefreshStatus()
  If Not g_qt Is Nothing Then
    If g_qt.Refreshing Then
      '继续定时检查
      Application.OnTime Now + TimeValue("00:00:01"), "CheckRefreshStatus", , True
    Else
      '刷新完成，清理全局变量
      Set g_qt = Nothing
    End If
  End If
End Sub

方案2：绕开列表对象，直接获取PowerQuery结果 #

通过Microsoft.Mashup.Engine.Interface库直接调用PowerQuery引擎执行M代码，手动将结果写入工作表，完全规避QueryTable的异步问题：

1. 先在VBE中引用Microsoft.Mashup.Engine.Interface（工具→引用→勾选对应项）
2. 使用以下代码：

Public Sub ExecuteM_GetDataDirectly(ByVal mCode As String)
  Dim mashupEngine As New MashupEngine
  Dim evaluationResult As MashupEvaluationResult
  Dim table As MashupTable
  Dim ws As Worksheet
  Dim rowIdx As Long, colIdx As Long
  
  '执行M代码并获取结果
  Set evaluationResult = mashupEngine.Evaluate(mCode)
  If evaluationResult.Value.ValueType.Name <> "Table" Then Exit Sub
  Set table = evaluationResult.Value.AsTable
  
  '新建工作表并写入数据
  Set ws = Workbooks.Add.Sheets(1)
  
  '写入表头
  colIdx = 1
  For Each col In table.Columns
    ws.Cells(1, colIdx).Value = col.Name
    colIdx = colIdx + 1
  Next
  
  '写入数据行
  rowIdx = 2
  For Each row In table.Rows
    colIdx = 1
    For Each col In table.Columns
      ws.Cells(rowIdx, colIdx).Value = row.Value(col.Name).ToString
      colIdx = colIdx + 1
    Next
    rowIdx = rowIdx + 1
  Next
  
  '清理对象
  Set evaluationResult = Nothing
  Set mashupEngine = Nothing
End Sub

'测试代码
Sub testM_Direct()
  Call ExecuteM_GetDataDirectly("#table({""a"",""b""},{{1,2},{3,4}})")
End Sub

该方案更适合异步场景，可直接结合stdFiber在纤程中执行，无需依赖Excel的QueryTable刷新机制。

内容的提问来源于stack exchange，提问作者Sancarn