Import CSV with power query vba

Question

I would like the user to select a csv file and import the file using power query. I'm stuck and have difficulties to find the answer I'm looking for. This is what I have so far:

Dim importPathVar1, importPathVar2 As Variant
Dim Filename As String

i = 1

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Excel Files", "*.csv", 1
    If .Show = True Then
        For Each importPathVar1 In .SelectedItems
            If i > 1 Then
                MsgBox "You selected to many files. Please select maximum 1 file."
                Exit Sub

            End If

            If i = 1 Then
                importPathVar2 = importPathVar1

            End If

            i = i + 1

        Next

     Else
        Exit Sub

     End If

End With

Filename = Dir(importPathVar2)

ActiveWorkbook.Queries.Add Name:= _
    Filename, Formula:= _
    "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(File.Contents(""" & importPathVar2 & """),[Delimiter=""    "", Columns=37, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.Transfo" & _
    "rmColumnTypes(#""Promoted Headers"",{{""reference"", Int64.Type}, {""ship_date_value"", type date}, {""carrier_name"", type text}, {""service_name"", type text}, {""carrier_shipment_id"", type text}, {""consignee_id"", Int64.Type}, {""prod"", type text}, {""ship_to_name"", type text}, {""ship_to_address1"", type text}, {""ship_to_address2"", type text}, {""ship_to_a" & _
    "ddress3"", type text}, {""ship_to_city"", type text}, {""ship_to_state"", type text}, {""ship_to_postal_code"", type text}, {""ship_to_country_id"", type text}, {""service_def_code"", type text}, {""fq_arrive_date_value"", type date}, {""wms_origin"", type text}, {""est_del_date_value"", type date}, {""est_del_time_value"", type time}, {""total_packages_count"", Int" & _
    "64.Type}, {""consolidated_to"", Int64.Type}, {""seqnum"", Int64.Type}, {""package_reference"", Int64.Type}, {""tracking_number"", type text}, {""package_sort"", type text}, {""performance_result"", type text}, {""original_order_ref"", Int64.Type}, {""tracking_status_code"", type text}, {""tracking_status_message"", type text}, {""manifest_transmit_date_value"", type" & _
    " date}, {""actual_delivery_date"", type date}, {""first_tracking_exception_message"", type text}, {""last_tracking_exception_message"", type text}, {""sub_orderid"", Int64.Type}, {""transit_days"", Int64.Type}, {""actual_delivery_time"", type time}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location= " & Filename & ";Extended Proper" _
    , "ties="""""), Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array( _
    "SELECT * FROM [" & Filename & "]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = Filename
    .Refresh BackgroundQuery:=False
End With
Application.CommandBars("Queries and Connections").Visible = False

I'm getting an invalid character error. This is the file name I selected "PerformanceExceptionReportKnapp_20191009152409.csv". I would very much appriciate if someone could point me in the right direction.

Answer 1

I would shorten the beginning of the code like that

Sub TestImport()

    Dim importPathVar As Variant
    Dim Filename As String

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.csv", 1
        If .Show = True Then
            importPathVar = .SelectedItems(1)
            Filename = Dir(importPathVar)
            MsgBox Filename
        Else
            MsgBox "You pressed Cancel"
        End If

    End With

End Sub

Update: The issue is indeed the name of the query. The extension .csv causes the error and you need to remove the extension from the filename.

Filename = FileNameNoExtensionFromPath(importPathVar)

With the following function you remove the extension

Function FileNameNoExtensionFromPath(ByVal strFullPath As String) As String

    Dim intStartLoc As Integer
    Dim intEndLoc As Integer
    Dim intLength As Integer

    intStartLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "\") - 1)
    intEndLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "."))
    intLength = intEndLoc - intStartLoc

    FileNameNoExtensionFromPath = Mid(strFullPath, intStartLoc, intLength)

End Function

Yoru complete code could then look like that

Sub TestImport()

    Dim importPathVar As Variant
    Dim Filename As String

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.csv", 1
        If .Show = True Then
            importPathVar = .SelectedItems(1)
            Filename = Dir(importPathVar)
            MsgBox Filename
        Else
            MsgBox "You pressed Cancel"
            Exit Sub
        End If

    End With


    Filename = FileNameNoExtensionFromPath(importPathVar)

    ActiveWorkbook.Queries.Add Name:= _
        Filename, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(File.Contents(""" & importPathVar & """),[Delimiter=""    "", Columns=37, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.Transfo" & _
        "rmColumnTypes(#""Promoted Headers"",{{""reference"", Int64.Type}, {""ship_date_value"", type date}, {""carrier_name"", type text}, {""service_name"", type text}, {""carrier_shipment_id"", type text}, {""consignee_id"", Int64.Type}, {""prod"", type text}, {""ship_to_name"", type text}, {""ship_to_address1"", type text}, {""ship_to_address2"", type text}, {""ship_to_a" & _
        "ddress3"", type text}, {""ship_to_city"", type text}, {""ship_to_state"", type text}, {""ship_to_postal_code"", type text}, {""ship_to_country_id"", type text}, {""service_def_code"", type text}, {""fq_arrive_date_value"", type date}, {""wms_origin"", type text}, {""est_del_date_value"", type date}, {""est_del_time_value"", type time}, {""total_packages_count"", Int" & _
        "64.Type}, {""consolidated_to"", Int64.Type}, {""seqnum"", Int64.Type}, {""package_reference"", Int64.Type}, {""tracking_number"", type text}, {""package_sort"", type text}, {""performance_result"", type text}, {""original_order_ref"", Int64.Type}, {""tracking_status_code"", type text}, {""tracking_status_message"", type text}, {""manifest_transmit_date_value"", type" & _
        " date}, {""actual_delivery_date"", type date}, {""first_tracking_exception_message"", type text}, {""last_tracking_exception_message"", type text}, {""sub_orderid"", Int64.Type}, {""transit_days"", Int64.Type}, {""actual_delivery_time"", type time}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location= " & Filename & ";Extended Proper" _
        , "ties="""""), Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array( _
            "SELECT * FROM [" & Filename & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = Filename
        .Refresh BackgroundQuery:=False
    End With
    Application.CommandBars("Queries and Connections").Visible = False
End Sub


Function FileNameNoExtensionFromPath(ByVal strFullPath As String) As String

    Dim intStartLoc As Integer
    Dim intEndLoc As Integer
    Dim intLength As Integer

    intStartLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "\") - 1)
    intEndLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "."))
    intLength = intEndLoc - intStartLoc

    FileNameNoExtensionFromPath = Mid(strFullPath, intStartLoc, intLength)

End Function