如何去除ADODB Recordset字段名中的Power Pivot表名前缀？

我通过VBA代码将Excel Power Pivot模型的数据导入ADODB Recordset，功能可以正常实现，但Recordset返回的字段名格式是Tablename[Columnname]，而不是我需要的仅列名。请问该如何修改？

原始可运行代码：

Public Sub ExportModelTable()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim tbl As ModelTable
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim qry As String
    Dim i As Long
    Dim f As ADODB.Field
    Dim col As ModelTableColumn
    
    Set wb = ThisWorkbook
    
    wb.Model.Initialize
    Set tbl = ThisWorkbook.Model.ModelTables(2)

    qry = "EVALUATE " & "'" & tbl.Name & "'"
    Set cn = wb.Model.DataModelConnection.ModelConnection.ADOConnection
    
    Set rs = New ADODB.Recordset
    With rs
        .Source = qry
        .ActiveConnection = cn
        .CursorType = 1
        .LockType = 1
        .Open
    End With
        
    For Each f In rs.Fields
        i = i + 1
        Blad2.Cells(1, i).Value = f.Name
        Debug.Print f.Name
        'prints Tablename[Columnname]
    Next f
    
    For Each col In tbl.ModelTableColumns
        Debug.Print col.Name
        'prints Columnname
    Next col
    
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing

End Sub

解决方案1：修改DAX查询，显式指定列别名 #

直接在DAX的EVALUATE语句中使用SELECTCOLUMNS函数，给每一列指定别名（即原列名），这样Recordset返回的字段名就会是纯列名，无需后续处理。

完整修改后的代码：

Public Sub ExportModelTable()

    Dim wb As Workbook
    Dim tbl As ModelTable
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim qry As String
    Dim i As Long
    Dim f As ADODB.Field
    Dim col As ModelTableColumn
    Dim colNames As String
    
    Set wb = ThisWorkbook
    
    wb.Model.Initialize
    Set tbl = ThisWorkbook.Model.ModelTables(2)

    ' 构建带列别名的DAX查询
    colNames = ""
    For Each col In tbl.ModelTableColumns
        If colNames <> "" Then colNames = colNames & ", "
        colNames = colNames & "[" & col.Name & "] AS [" & col.Name & "]"
    Next col
    qry = "EVALUATE SELECTCOLUMNS('" & tbl.Name & "', " & colNames & ")"
    
    Set cn = wb.Model.DataModelConnection.ModelConnection.ADOConnection
    
    Set rs = New ADODB.Recordset
    With rs
        .Source = qry
        .ActiveConnection = cn
        .CursorType = 1
        .LockType = 1
        .Open
    End With
        
    For Each f In rs.Fields
        i = i + 1
        Blad2.Cells(1, i).Value = f.Name
        Debug.Print f.Name ' 现在输出纯列名
    Next f
    
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing

End Sub

解决方案2：利用ModelTable列名映射替换Recordset字段名 #

既然已经能通过tbl.ModelTableColumns获取到纯列名，可以在遍历Recordset字段时，直接用对应索引的ModelTableColumn名称来替换f.Name，无需修改DAX查询。

完整修改后的代码：

Public Sub ExportModelTable()

    Dim wb As Workbook
    Dim tbl As ModelTable
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim qry As String
    Dim i As Long
    Dim f As ADODB.Field
    Dim col As ModelTableColumn
    
    Set wb = ThisWorkbook
    
    wb.Model.Initialize
    Set tbl = ThisWorkbook.Model.ModelTables(2)

    qry = "EVALUATE " & "'" & tbl.Name & "'"
    Set cn = wb.Model.DataModelConnection.ModelConnection.ADOConnection
    
    Set rs = New ADODB.Recordset
    With rs
        .Source = qry
        .ActiveConnection = cn
        .CursorType = 1
        .LockType = 1
        .Open
    End With
        
    i = 0
    For Each f In rs.Fields
        i = i + 1
        ' 用ModelTable的列名替换Recordset的字段名
        Blad2.Cells(1, i).Value = tbl.ModelTableColumns(i - 1).Name
        Debug.Print tbl.ModelTableColumns(i - 1).Name ' 输出纯列名
    Next f
    
    For Each col In tbl.ModelTableColumns
        Debug.Print col.Name
        'prints Columnname
    Next col
    
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing

End Sub

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