Export a table or DAX query from Power Pivot to CSV using VBA

Had an interesting question today. Someone did some great transformations combining multiple files into a single table and adding some calculations using Power Query and Power Pivot. Now he wanted to load that data into CloudML to do some machine learning on top of this data. Currently cloudML takes csv files so the question was how can I get data from the Power Pivot model into a CSV even when there are more than 1.000.000 rows.

It turned out to be pretty easy by combining two other blog posts: one of my blogs on how to access the data model combined with this blog I found on how to write to CSV from vba.

Merging these two together gives us a new macro that we can run.

Please note the following:

  • Change the query used below, you either need to do “EVALUATE <TABLENAME>” or write your own query
  • Make sure you have the file that I am writing to below
  • Add a reference to the ADO library in your VBA code.

All of this gives the following Macro :

Option Explicit
Public Sub ExportToCsv()

    Dim wbTarget As Workbook
    Dim ws As Worksheet
    Dim rs As Object
    Dim sQuery As String

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

    'Bind to active workbook
    Set wbTarget = ActiveWorkbook

    Err.Clear

    On Error GoTo ErrHandler

    'Make sure the model is loaded
    wbTarget.Model.Initialize

    'Send query to the model
    sQuery = "EVALUATE <YOURPRODUCT>"
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open sQuery, wbTarget.Model.DataModelConnection.ModelConnection.ADOConnection
    Dim CSVData As String
    CSVData = RecordsetToCSV(rs, True)
    
    'Write to file
    Open "C:tempMyFileName.csv" For Binary Access Write As #1
        Put #1, , CSVData
    Close #1
    
    rs.Close
    Set rs = Nothing
    
ExitPoint:
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Set rs = Nothing
    Exit Sub

ErrHandler:
    MsgBox "An error occured - " & Err.Description, vbOKOnly
    Resume ExitPoint
End Sub



Public Function RecordsetToCSV(rsData As ADODB.Recordset, _
        Optional ShowColumnNames As Boolean = True, _
        Optional NULLStr As String = "") As String
    'Function returns a string to be saved as .CSV file
    'Option: save column titles

    Dim K As Long, RetStr As String
    
    If ShowColumnNames Then
        For K = 0 To rsData.Fields.Count - 1
            RetStr = RetStr & ",""" & rsData.Fields(K).Name & """"
        Next K
        
        RetStr = Mid(RetStr, 2) & vbNewLine
    End If
    
    RetStr = RetStr & """" & rsData.GetString(adClipString, -1, """,""", """" & vbNewLine & """", NULLStr)
    RetStr = Left(RetStr, Len(RetStr) - 3)
    
    RecordsetToCSV = RetStr
End Function

Happy exporting :).