Импорт csv с цитированной новой строкой с использованием QueryTables в Excel

Question

Я написал визуальный базовый макрос для загрузки CSV-файла в Excel, который я использую довольно часто.

К сожалению, если файл csv содержит цитированные символы новой строки, результат отличается от того, что вы получили бы, если бы вы открыли файл csv напрямую с помощью excel. В отличие от обычного объекта импорта, QueryTables.add() предполагает, что любая новая строка, с которой она сталкивается, является ли котировка или нет, является концом строки.

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

Соответствующая часть моего макроса:

Sub LoadMyFile() 
    ' Query the table of interest 
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _ 
     & ThisWorkbook.Path & "\" & Range("A1").Value & ".csv", _ 
     Destination:=Range("$A$2")) 
     .Name = ActiveSheet.Name 
     .FieldNames = True 
     .RowNumbers = False 
     .FillAdjacentFormulas = False 
     .PreserveFormatting = True 
     .RefreshOnFileOpen = False 
     .RefreshStyle = xlOverwriteCells 
     .SavePassword = False 
     .SaveData = True 
     .AdjustColumnWidth = True 
     .RefreshPeriod = 0 
     .TextFilePromptOnRefresh = False 
     .TextFilePlatform = 437 
     .TextFileStartRow = 1 
     .TextFileParseType = xlDelimited 
     .TextFileTextQualifier = xlTextQualifierDoubleQuote 
     .TextFileConsecutiveDelimiter = False 
     .TextFileTabDelimiter = False 
     .TextFileSemicolonDelimiter = False 
     .TextFileCommaDelimiter = True 
     .TextFileSpaceDelimiter = False 
     .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1) 
     .TextFileTrailingMinusNumbers = True 
     .Refresh BackgroundQuery:=False 
    End With 
End Sub 

Вот пример файла CSV с цитируемым новой строкой

"firstCol","secondCol" 
"name1","data 
one" 
"name 
2","data two" 

Макрос считывает имя файла (без расширения .csv) из ячейки A1 и предполагает, что файл csv находится в том же каталоге, что и файл excel, содержащий макрос.

Я использую 32-разрядный Office Professional 2010 на машине с Windows 7.

Answer 1

импорт таких CSV-файлов (новые строки в точках данных) работает только с рабочей книгой. Открывается и только с CSV-файлами в формате локали (разделитель, разделитель текста) используется Excel.

Set wb = Workbooks.Open(Filename:="C:\Users\axel\Desktop\test.csv", Local:=True) 

aData = wb.Worksheets(1).UsedRange.Value 
lRows = UBound(aData, 1) 
lCols = UBound(aData, 2) 

With ActiveSheet 
.Range(.Cells(1, 1), .Cells(lRows, lCols)).Value = aData 
End With 

wb.Close 

Привет

Axel

Answer 2

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

Примечание. Я не привык использовать средства поиска, относящиеся к методу Open, на которых я опишу здесь, и у меня все еще есть пара опасений, которые они действительно работают в некоторых контекстах tbh, но после запуска нескольких тестов код выглядит просто отлично.

Sub csvImportbis() 

    Dim s As String 
    Dim i As Long 
    Dim j As Long 
    Dim a() As String 

    myfile = FreeFile 
    i = 1 
    j = 1 

    'ENTER YOUR PATH/FILE NAME HERE 
    Open "YOUR_PATH/FILENAME" For Input As #myfile 

     Do Until EOF(myfile) 

      Do 
       Input #myfile, s 
       cur = Seek(myfile) 
       Seek myfile, cur - 1 
       i = i + 1 
      Loop While input(1, #myfile) <> vbLf 

      ReDim a(1 To i - 1, 1 To 10000) 

      i = 1 

      Seek #myfile, 1 

      Do Until EOF(myfile) 

       Input #myfile, a(i, j) 
       i = i + 1 

       If i > UBound(a, 1) Then 
        i = 1 
        j = j + 1 
       End If 

       If j > UBound(a, 2) Then 
        ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 10000) 
       End If 

      Loop 

     Loop 

    Close #myfile 

    sup = j 

    ReDim Preserve a(1 To UBound(a, 1), 1 To sup) 

    'QUALIFY THE RANGE WITH YOUR WORKBOOK & WORKSHEET REFERENCES 
    Range("A1").Resize(sup, UBound(a, 1)) = WorksheetFunction.Transpose(a) 

End Sub