能否通过VBA在Excel中自动将Power Query添加至数据模型？

我有一个工作表，后续要创建大量Power Query，想借助Excel数据模型的数据透视表及性能优势。已经通过VBA实现从SharePoint文件夹获取查询，但还想把这些查询添加至数据模型。尝试了以下VBA代码，能创建查询，但无法将连接添加到Data Model：

Sub CreateQueryAndAddToDataModel()
    Dim queryName As String
    Dim connectionName As String
    Dim connectionStr As String
    
    ' Set the query and connection names
    queryName = "MyPowerQuery"
    connectionName = "MyConnection"
    
    ' Set the connection string with the query name
    connectionStr = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName & ";"
    
    
    Dim M_Script As String
    M_Script = "Let Source = Csv.Document(Web.Contents(SHAREPOINTPATH)) in Source"
    
    
    
    ' Create the query and connection
    ActiveWorkbook.Queries.Add Name:=queryName, Formula:=M_Script
    
    ' Add the connection to the workbook
    ThisWorkbook.Connections.Add Name:=connectionName, Description:="", _
        ConnectionString:=connectionStr, CommandText:="", lCmdtype:=xlCmdSql
    
    ' Refresh the connection to load data into the data model
    ThisWorkbook.Connections(connectionName).Refresh
End Sub

现有代码仅创建了普通工作簿连接，未关联到数据模型。要实现Power Query与数据模型的绑定，需调整连接创建逻辑，关键在于使用支持数据模型的连接方法，并明确关联模型表：

修正后的代码：

Sub CreateQueryAndAddToDataModel()
    Dim queryName As String
    Dim connectionName As String
    Dim connectionStr As String
    Dim conn As WorkbookConnection
    
    ' 设置查询和连接名称
    queryName = "MyPowerQuery"
    connectionName = "MyConnection"
    
    ' 构建指向Power Query的连接字符串
    connectionStr = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName & ";"
    
    ' 修正M脚本的字符串引号（替换SHAREPOINTPATH为实际路径）
    Dim M_Script As String
    M_Script = "let Source = Csv.Document(Web.Contents(""SHAREPOINTPATH"")) in Source"
    
    ' 创建Power Query
    ActiveWorkbook.Queries.Add Name:=queryName, Formula:=M_Script
    
    ' 创建关联数据模型的连接
    Set conn = ThisWorkbook.Connections.Add2( _
        Name:=connectionName, _
        Description:="Power Query 关联数据模型", _
        ConnectionString:=connectionStr, _
        CommandText:="", _
        lCmdtype:=xlCmdSql, _
        CreateModelConnection:=True, ' 核心参数：指定连接归属数据模型
        ImportRelationships:=False _
    )
    
    ' 将查询注册为数据模型中的表
    conn.ModelConnection.ModelTables.Add Name:=queryName, SourceWorkbookConnection:=conn
    
    ' 刷新连接加载数据
    conn.Refresh
End Sub

关键修改说明 #

1. 使用Connections.Add2替代Add：该方法新增CreateModelConnection参数，直接标记连接属于数据模型
2. 添加ModelTables.Add：将Power Query正式注册为数据模型内的可用表
3. 修正M脚本语法：原代码中SHAREPOINTPATH未加双引号，会导致M语言解析错误，需补充包裹路径字符串

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