Как использовать vb для извлечения DAX Query в CSV при замене запятой на пробел - PullRequest
0 голосов
/ 10 января 2019

Я нашел макрос для экспорта запроса DAX в CSV, но у меня возникли проблемы с одним из столбцов, где ячейка содержит запятую. Я думаю, что VB на самом деле не учитывал, когда в ячейке с запятой есть запятая. Что я могу изменить в VB, чтобы заменить запятую пробелом, прежде чем она будет записана в файл CSV? Вставить это в powerquery, к сожалению, не вариант ...

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 CALCULATETABLE('Query 3')"
    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:\abc.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
...