咨询通过VBA连接Power BI Desktop导出超限额数据的方案

针对你的需求，我整理了两种完全符合要求的方案——直接用VBA连接Power BI Desktop提取数据，或者用VBA调用你现有的PowerShell脚本，都能绕过Power BI的默认导出限额，而且完全不用碰R语言。

方案一：直接用VBA连接Power BI Desktop提取数据 #

和你找到的PowerShell脚本思路一致，Power BI Desktop运行时会在本地启动一个隐藏的Analysis Services实例，我们可以用ADOMD.NET（和PowerShell里用的是同一个库）通过VBA连接这个实例，直接提取全量数据。

步骤和代码示例： #

1. 确保Power BI Desktop处于打开状态（要提取数据的.pbix文件必须打开）
2. 在VBA编辑器里添加引用：
   • 打开VBA编辑器（按Alt+F11）
   • 点击「工具」→「引用」，找到并勾选Microsoft.AnalysisServices.AdomdClient（如果找不到，可安装SQL Server Analysis Services客户端工具）
3. 运行以下VBA代码：

Sub ExtractPBIXDataToCSV()
    Dim conn As New AdomdConnection
    Dim cmd As New AdomdCommand
    Dim adapter As New AdomdDataAdapter
    Dim dataset As New DataSet
    Dim outputPath As String
    Dim query As String
    
    ' 配置参数，请替换成你的实际值
    conn.ConnectionString = "Data Source=localhost:55555;Initial Catalog=模型;Timeout=0"
    query = "EVALUATE '你的目标表名'" ' 可替换为自定义DAX查询
    outputPath = "C:\Temp\导出数据.csv"
    
    On Error GoTo Cleanup
    ' 打开连接
    conn.Open
    
    ' 执行查询并填充数据集
    cmd.CommandText = query
    cmd.Connection = conn
    adapter.SelectCommand = cmd
    adapter.Fill(dataset)
    
    ' 导出为CSV
    If dataset.Tables.Count > 0 Then
        ExportDataTableToCSV dataset.Tables(0), outputPath
        MsgBox "数据导出成功！路径：" & outputPath
    Else
        MsgBox "未查询到数据"
    End If
    
Cleanup:
    ' 清理资源
    If Not dataset Is Nothing Then Set dataset = Nothing
    If Not adapter Is Nothing Then Set adapter = Nothing
    If Not cmd Is Nothing Then Set cmd = Nothing
    If conn.State = adStateOpen Then conn.Close
    If Not conn Is Nothing Then Set conn = Nothing
End Sub

' 辅助函数：将DataTable导出为UTF-8编码的CSV
Sub ExportDataTableToCSV(dt As DataTable, filePath As String)
    Dim fs As Object
    Dim writer As Object
    Dim i As Integer, j As Integer
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set writer = fs.CreateTextFile(filePath, True, True) ' 第二个True代表UTF-8编码
    
    ' 写入表头
    For j = 0 To dt.Columns.Count - 1
        If j > 0 Then writer.Write ","
        writer.Write """" & Replace(dt.Columns(j).ColumnName, """", """""") & """"
    Next j
    writer.WriteLine
    
    ' 写入数据行
    For i = 0 To dt.Rows.Count - 1
        For j = 0 To dt.Columns.Count - 1
            If j > 0 Then writer.Write ","
            writer.Write """" & Replace(dt.Rows(i)(j), """", """""") & """"
        Next j
        writer.WriteLine
    Next i
    
    writer.Close
    Set writer = Nothing
    Set fs = Nothing
End Sub

注意事项： #

• Power BI Desktop的本地端口可能不是55555，可在Power BI的「帮助」→「关于」里查看“本地实例”的完整地址
• DAX查询支持自定义筛选、聚合等逻辑，灵活控制提取的数据范围

方案二：用VBA调用你的PowerShell脚本 #

如果更倾向于复用已有的PowerShell代码，VBA可以轻松实现调用，提供两种方式：

方式1：直接在VBA中嵌入PowerShell代码 #

把你提供的PowerShell代码整合到VBA里执行，无需单独的.ps1文件：

Sub RunPowerShellScriptFromVBA()
    Dim psScript As String
    Dim shellCmd As String
    Dim dataSource As String
    Dim databaseName As String
    Dim query As String
    Dim outputPath As String
    
    ' 配置参数，请替换成你的实际值
    dataSource = "localhost:55555"
    databaseName = "模型"
    query = "EVALUATE '你的目标表名'"
    outputPath = "C:\Temp\导出数据.csv"
    
    ' 构建PowerShell脚本内容
    psScript = "$dataSource = """ & dataSource & """" & vbCrLf & _
               "$Database_Name = """ & databaseName & """" & vbCrLf & _
               "$query = """ & Replace(query, """", """""") & """" & vbCrLf & _
               "$filename = """ & outputPath & """" & vbCrLf & _
               "[System.Reflection.Assembly]::LoadWithPartialName(""Microsoft.AnalysisServices.AdomdClient"")" & vbCrLf & _
               "$con = new-object Microsoft.AnalysisServices.AdomdClient.AdomdConnection" & vbCrLf & _
               "$con.ConnectionString = ""Datasource=$dataSource; Initial Catalog=$Database_Name;timeout=0; connect timeout =0""" & vbCrLf & _
               "$con.Open()" & vbCrLf & _
               "$command = $con.CreateCommand()" & vbCrLf & _
               "$command.CommandText = $query" & vbCrLf & _
               "$adapter = New-Object -TypeName Microsoft.AnalysisServices.AdomdClient.AdomdDataAdapter $command" & vbCrLf & _
               "$dataset = New-Object -TypeName System.Data.DataSet" & vbCrLf & _
               "$adapter.Fill($dataset)" & vbCrLf & _
               "$dataset.Tables[0] | export-csv $filename -notypeinformation" & vbCrLf & _
               "$con.Close()"
    
    ' 构建执行命令，临时放宽PowerShell执行策略
    shellCmd = "powershell -ExecutionPolicy RemoteSigned -Command """ & Replace(psScript, """", """""") & """"
    
    ' 后台执行脚本
    Shell shellCmd, vbHide
    
    MsgBox "PowerShell脚本已执行，数据导出路径：" & outputPath
End Sub

方式2：调用外部的.ps1文件 #

如果已经把PowerShell代码保存为独立脚本文件，可直接调用：

Sub RunExternalPowerShellScript()
    Dim shellCmd As String
    Dim scriptPath As String
    
    ' 替换成你的.ps1文件路径
    scriptPath = "C:\Scripts\ExtractPBIXData.ps1"
    
    ' 执行脚本，临时设置执行策略
    shellCmd = "powershell -ExecutionPolicy RemoteSigned -File """ & scriptPath & """"
    
    Shell shellCmd, vbHide
    MsgBox "外部PowerShell脚本已执行完成"
End Sub

注意事项： #

• 系统默认的PowerShell执行策略可能阻止脚本运行，命令中添加-ExecutionPolicy RemoteSigned可临时放宽权限，无需修改全局设置
• 若PowerShell脚本需要传递参数，可在命令中追加，例如：-File "script.ps1" -dataSource "localhost:55555"

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