简体   繁体   中英

Power Query single-character string error vba

With below code I would like to give the user the posibility to select a csv file and import the file with power query:

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

Unfortunately I get an error on line .Refresh BackgroundQuery:=False with message

expression error The value isn't a single character-string

I have no idea what is wrong with the code and on the internet there are not much topics on this error. Can someone please help?

I have found the solution. The CSV file I was importing is tab delimited. The following line solved the error: Delimiter=""" & vbTab & """.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM