Power Query 系列 (20) - 如何在外部使用Power Query提供的服务

Public Function ExportExcelDataModel(
	excelFilePath As String, 
	modelName As String, 
	targetSheet As Worksheet)
	
    '''Reference: Microsoft ActiveX Data Objects
 
    Dim wbTarget As Workbook  'target workbook
    Dim ws As Worksheet
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sQueryString As String

    'Suppress alerts and screen updates
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Err.Clear
    On Error GoTo ErrHandler
    
    Set wbTarget = Application.Workbooks.Open(excelFilePath)
 
    'Make sure the model is loaded
    wbTarget.Model.Initialize
    wbTarget.Model.Refresh

    Set conn = wbTarget.Model.DataModelConnection.ModelConnection.ADOConnection
    sQueryString = "EVALUATE '" & modelName & "'"
    
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Open sQueryString, conn
    
    targetSheet.Cells.ClearContents
    ' Write header
    Dim colIndex As Integer
    For colIndex = 0 To rs.Fields.Count - 1
        targetSheet.Range("A1").Offset(0, colIndex).Value = rs.Fields(colIndex).Name
    Next
    
    ' Write Lines
    targetSheet.Range("A1").Offset(1, 0).CopyFromRecordset rs
 
    rs.Close
    Set rs = Nothing    
    ' Close workbook
    wbTarget.Close
 
ExitPoint:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Set rs = Nothing
    Exit Function
 
ErrHandler:
    MsgBox "An error occured - " & Err.Number & "," & Err.Description, vbOKOnly
    Resume ExitPoint
End Function

Public Sub DoExport()
    Dim filePath As String
    filePath = ThisWorkbook.Path & "\pqservice.xlsx"

    Dim conn As New ADODB.Connection
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Extended Properties=""Excel 12.0;HDR=No"";" & _
        "data source=" & filePath
    
    ' Update cell in another excel workbook
    Dim sql As String
    sql = "UPDATE [Criteria$A1:B3] SET F2=5 WHERE F1='month'"
    conn.Open
    conn.Execute sql
    conn.Close
    
    ' Retrieve data
    Dim sht As Worksheet
    Set sht = Sheet1    
    Call ExportExcelDataModel(filePath, "stock_balance", sht)
    
    sht.Activate
End Sub

sql = "UPDATE [Criteria$A1:B3] SET F2=5 WHERE F1='month'"