Import csv with quoted newline using QueryTables in Excel

Question

I have written a visual basic macro to load a csv file into Excel that I use quite frequently.

Unfortunately, if the csv file contains quoted newlines, the result is different from what you would get if you opened the csv file directly with excel. Unlike the usual import facility, QueryTables.add() assumes any newline it runs into, whether quoted or not, is the end of the row.

Is there a way around this? I'd prefer a solution that did not involve pre-modifying the incoming csv files to remove the newlines, but I'm open to suggestions on that front as well. I do want to have newlines in the resulting excel file cells, though.

The relevant part of my macro:

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

Here's an example csv file with quoted newlines

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

The macro reads the file name (minus the .csv extension) from cell A1 and assumes the csv file is in the same directory as the excel file containing the macro.

I'm using 32 bit Office Professional 2010 on a windows 7 machine.

Answer 1

the import of such CSV files (newlines in data-points) works only with Workbooks.Open and only with CSVs in the locale format (delimiter, text-delimiter), the Excel is used.

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

Greetings

Axel

Answer 2

Edit: the code previously provided was actually designed with the specific example you provided in mind, with 2 columns and a relatively small number of data in the source CSV. I have reviewed the code below to fit other possible scenarios - also including a number of optimizations for runtime efficiency as well.

Note I am not used to using the seeking facilities relating to the Open method that I am relying on here, and I still have a couple misgivings re the way they actually work in some contexts tbh, but after running a couple tests the code looks to work just fine.

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