Экспорт из модели данных в *.csv (PowerQuery)

[unbanned]

Всем доброго времени суток!

Хочу поделится способом экспорта из модели данных в *.csv.
Думаю кому-нибудь пригодится, т.к. поиск на эту тему выдает очень мало информации.
Также буду рад комментариям по поводу написанного кода (частично мой, частично скопипащено). Сразу хочу сказать, что программистом я не являюсь

'Экспорт в CSV из модели данных PowerQuery
'31.10.2019

'Для работы нужно активировать библиотеки (Tools -> Preferences...):
'-Microsoft Scripting Runtime
'-Microsoft ActiveX Data Objects 6.1 Library

Option Explicit

Public FSO     As New FileSystemObject

Sub main()

    Dim ModelList As String
    Dim OFD    As FileDialog
    Dim i      As Integer
    Dim ModelNum As Integer
    Dim tmp    As String

    ModelList = "Доступные в данной книге модели:" + Chr(10) + Chr(13) + Chr(13)
    If ThisWorkbook.Model.ModelTables.Count <> 0 Then
        For i = 1 To ThisWorkbook.Model.ModelTables.Count
            ModelList = ModelList & i & ". " & ThisWorkbook.Model.ModelTables.Item(i).Name & Chr(10) & Chr(13)
        Next i
    Else

        ModelList = ModelList & " Нет доступных моделей"

    End If


ModelNameInput:

    ModelNum = 0
    tmp = InputBox(ModelList, "Введите номер модели")

    If IsNumeric(tmp) Then
        If CInt(tmp) > ThisWorkbook.Model.ModelTables.Count Or CInt(tmp) <= 0 Then
            MsgBox "Incorrect Model num", vbOKOnly
            GoTo ModelNameInput
        Else
            ModelNum = CInt(tmp)
        End If
    Else
        If tmp <> "" Then
            MsgBox "Incorrect Model num", vbOKOnly
            GoTo ModelNameInput
        Else
            Exit Sub
        End If
    End If

    Set OFD = Application.FileDialog(msoFileDialogSaveAs)

    OFD.Title = "Выберите путь и имя файла"
    OFD.ButtonName = "Сохранить"
    OFD.FilterIndex = 15
    OFD.InitialFileName = "export.csv"
    OFD.InitialView = msoFileDialogViewLargeIcons

    If OFD.Show <> 0 Then
        Call ExportToCsv(ThisWorkbook.Model.ModelTables.Item(ModelNum).Name, OFD.SelectedItems.Item(1))
    Else
    End If

    Set OFD = Nothing
End Sub

Public Sub ExportToCsv(QueryName As String, ExportPath As String)

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

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Set wbTarget = ActiveWorkbook

    Err.Clear

    On Error GoTo ErrHandler

    wbTarget.Model.Initialize

    sQuery = "EVALUATE '" & QueryName & "'"
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open sQuery, wbTarget.Model.DataModelConnection.ModelConnection.ADOConnection
    Dim CSVData As String
    Call WriteRecordsetToCSV(rs, ExportPath, True)

    rs.Close
    Set rs = Nothing
    MsgBox "Save success", vbOKOnly

ExitPoint:
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Set rs = Nothing
    Exit Sub

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

Public Sub WriteRecordsetToCSV(rsData As ADODB.Recordset, _
        FileName As String, _
        Optional ShowColumnNames As Boolean = True, _
        Optional NULLStr As String = "")

    Dim TxtStr As TextStream
    Dim i As Long, CSVData As String

    Set TxtStr = FSO.CreateTextFile(FileName, True)

    If ShowColumnNames Then
        For i = 0 To rsData.Fields.Count - 1
            CSVData = CSVData & ";""" & Mid(rsData.Fields(i).Name, InStr(1, rsData.Fields(i).Name, "[") + 1, Len(rsData.Fields(i).Name) - InStr(1, rsData.Fields(i).Name, "[") - 1) & """"
        Next i

        CSVData = Mid(CSVData, 2) & vbNewLine
        TxtStr.Write CSVData
    End If

    Do While rsData.EOF = False
        CSVData = """" & rsData.GetString(adClipString, 1000, """;""", """" & vbNewLine & """", NULLStr)
        CSVData = Left(CSVData, Len(CSVData) - IIf(rsData.EOF, 3, 2))
        TxtStr.Write CSVData
    Loop

    TxtStr.Close

End Sub

[AndVGri]

Доброе время суток.
Спасибо. Но как правило для этих целей всё же удобнее пользоваться DAX Studio

[unbanned]

вообщем-то так и есть. Но! не всегда есть возможность ставить сторонний софт.
за подсказку спасибо, попробую поюзать.

[nacimjon]

У меня выходить ощибка User definde type definde
как решить данную ощибку

[unbanned]

Сообщение от nacimjon

У меня выходить ощибка User definde type definde
как решить данную ощибку

скорее всего дело в этом:

Сообщение от unbanned

'Для работы нужно активировать библиотеки (Tools -> Preferences...):
'-Microsoft Scripting Runtime
'-Microsoft ActiveX Data Objects 6.1 Library