Открыть данные CSV с кодировкой

Question

Используя Excel 2016, у меня есть CSV-файл с именем «Abc-123.csv», который я уже открыл в Excel, поэтому сейчас у меня есть один лист с CSV.Я хочу снова открыть тот же файл (ActiveWorkbook) , используя Данные> Из текста / CSV и использовать кодировку 1252: Западноевропейская (Windows)

Я записал макрос, а затем изменил его на функцию, чтобы он мог получать внешний файл CSV.

Что мне нужно, это помочь сделать этот макрос более общим для случаев, когда мой CSV будет иметьдругое имя

Function Data_CSV(CSVFile)
    ActiveWorkbook.Queries.Add Name:="Abc-123", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(File.Contents(""C:\CSV\Abc-123.csv""),[Delimiter="","", Columns=43, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Sales Record Number"", Int64.Type}, {""User" & _
        " Id"", type text}, {""Buyer Fullname"", type text}, {""Buyer Phone Number"", type text}, {""Buyer Email"", type text}, {""Buyer Address 1"", type text}, {""Buyer Address 2"", type text}, {""Buyer City"", type text}, {""Buyer State"", type text}, {""Buyer Zip"", type text}, {""Buyer Country"", type text}, {""Order ID"", type number}, {""Item ID"", type number}, {""Tr" & _
        "ansaction ID"", type number}, {""Item Title"", type text}, {""Quantity"", Int64.Type}, {""Sale Price"", type text}, {""Shipping And Handling"", type text}, {""Sales Tax"", type text}, {""Insurance"", type text}, {""eBay Collected Tax"", type text}, {""Total Price"", type text}, {""Payment Method"", type text}, {""PayPal Transaction ID"", type text}, {""Sale Date"", " & _
        "type date}, {""Checkout Date"", type date}, {""Paid on Date"", type date}, {""Shipped on Date"", type date}, {""Shipping Service"", type text}, {""Feedback Left"", type text}, {""Feedback Received"", type text}, {""Notes to Yourself"", type text}, {""Custom Label"", type text}, {""Listed On"", type text}, {""Sold On"", type text}, {""Private Notes"", type text}, {""" & _
        "Product ID Type"", type text}, {""Product ID Value"", type text}, {""Product ID Value 2"", type text}, {""Variation Details"", type text}, {""Product Reference ID"", type text}, {""Tracking Number"", type text}, {""Phone"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
    ActiveWorkbook.Worksheets.Add

    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Abc-123;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Abc-123]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Abc_123"
        .Refresh BackgroundQuery:=False
    End With
End Function

Answer 1

Изображение настройки макроса

Я действительно предпочитаю подпрограммы, а не функции для импорта данных, но адаптация к функции не должна быть слишком сложной, если это то, что вам нужно.

Сначала создайте 3 именованных диапазона: «FileName», «SheetName» и «Extension».Затем вставьте этот код поверх кода, который вы используете.Я бы рекомендовал добавить кнопку в вашу электронную таблицу, если вы делаете это часто.

Это работает со многими типами текстовых файлов (.csv, .txt и т. Д.):

Sub LoadData()
    'This subroutine will load data from text-formatted files without opening them.
    Dim ThisWB As Workbook

    Set ThisWB = ThisWorkbook
    filename = Range("FileName").Value
    SheetName = Range("SheetName").Value
    extension = Range("Extension").Value

    If extension = ".csv" Then
        isCSV = True
    Else
        isCSV = False
    End If


    If (SheetExists(SheetName, ThisWB) = False) Then
        Call createSheet(SheetName, ThisWB)
    End If

    Sheets(SheetName).Select
    Sheets(SheetName).Cells(1, 1).Select

    With ActiveSheet.QueryTables _
        .Add(Connection:="TEXT;" & filename, Destination:=ActiveCell)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = (Not (isCSV))
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = isCSV
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    ActiveSheet.QueryTables.Item(ActiveSheet.QueryTables.Count).Delete

End Sub

Function SheetExists(ByVal shtName As String, Optional WB As Workbook) As Boolean
    'This subroutine will test to see if a worksheet already exists within a workbook
    Dim sht As Worksheet

     If WB Is Nothing Then Set WB = ThisWorkbook
     On Error Resume Next
     Set sht = WB.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
End Function

Sub createSheet(ByVal shtName As String, WB As Workbook)
    'This subroutine will create a sheet for the data to be imported to, if that sheet does not already exist.
    Dim ws As Worksheet
    With WB
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        ws.Name = shtName
    End With
End Sub

Надеюсь это поможет!:)