VBA导入CSV至Excel遇换行符错误 可否不修改原文件解决？

方案1：无需修改原文件/无需生成新文件（内存中直接处理） #

该方案通过ADODB.Stream读取CSV全量内容，在内存中识别并替换双引号包裹字段内的异常换行符，处理后直接写入工作表，完全不涉及磁盘文件修改。

Sub ImportCsvWithoutInvalidNewline()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim folder As String, fileName As String
    folder = ThisWorkbook.Path & "\"
    fileName = Dir(folder & "*.csv")
    If fileName = "" Then Exit Sub
    
    ' 读取全量CSV内容
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Charset = "utf-8" ' 可根据你的CSV编码调整，比如改为"gb2312"、"iso-8859-1"对应原代码850编码
    stream.Open
    stream.LoadFromFile folder & fileName
    Dim content As String
    content = stream.ReadText
    stream.Close
    Set stream = Nothing
    
    ' 处理异常换行：引号内部的换行替换为空格，保留正常行尾换行
    Dim processedContent As String, inQuote As Boolean, i As Long
    inQuote = False
    processedContent = ""
    For i = 1 To Len(content)
        Dim c As String
        c = Mid(content, i, 1)
        If c = """" Then
            inQuote = Not inQuote
            processedContent = processedContent & c
        ElseIf c = vbCr Or c = vbLf Then
            If Not inQuote Then
                ' 不在引号内，是正常行尾，保留换行
                processedContent = processedContent & vbCrLf
                ' 跳过连续的换行符
                If i < Len(content) And (Mid(content, i + 1, 1) = vbCr Or Mid(content, i + 1, 1) = vbLf) Then
                    i = i + 1
                End If
            Else
                ' 在引号内，是异常换行，替换为空格
                processedContent = processedContent & " "
            End If
        Else
            processedContent = processedContent & c
        End If
    Next
    
    ' 拆分处理后的内容直接写入工作表
    Dim rowsArr As Variant, rowArr As Variant, r As Long, c As Long
    rowsArr = Split(processedContent, vbCrLf)
    r = ActiveCell.Offset(1, 0).Row ' 对应你原来的导入起始位置
    For Each rowArr In rowsArr
        If Trim(rowArr) <> "" Then
            Dim cols As Variant
            cols = SplitCSVLine(CStr(rowArr)) ' 调用自定义拆分函数处理带引号的逗号
            For c = 0 To UBound(cols)
                ws.Cells(r, c + 1).Value = cols(c)
            Next
            r = r + 1
        End If
    Next
End Sub

' 辅助函数：按CSV规范拆分单行内容，区分字段内逗号和分隔逗号
Function SplitCSVLine(line As String) As Variant
    Dim cols As Collection, currentCol As String, inQuote As Boolean, i As Long
    Set cols = New Collection
    currentCol = ""
    inQuote = False
    For i = 1 To Len(line)
        Dim c As String
        c = Mid(line, i, 1)
        If c = """" Then
            If inQuote And i < Len(line) And Mid(line, i + 1, 1) = """" Then
                ' 处理转义的双引号
                currentCol = currentCol & """"
                i = i + 1
            Else
                inQuote = Not inQuote
            End If
        ElseIf c = "," And Not inQuote Then
            cols.Add currentCol
            currentCol = ""
        Else
            currentCol = currentCol & c
        End If
    Next
    cols.Add currentCol
    ' 转成数组返回
    Dim res As Variant
    ReDim res(0 To cols.Count - 1)
    For i = 1 To cols.Count
        res(i - 1) = cols(i)
    Next
    SplitCSVLine = res
End Function

方案2：生成新CSV文件的修正代码 #

你原有代码的问题是没有区分「字段内部的异常换行」和「合法的行尾换行」，直接移除所有换行符会导致所有行合并。修正逻辑为：统计当前内容的双引号数量，若为奇数说明当前换行属于字段内部的异常换行，需要拼接下一行并替换换行，直到双引号数量为偶数才判定为合法行尾，写入新文件。

Sub FixCsvNewline()
    Dim fso As Object, tsIn As Object, tsOut As Object
    Dim s As String, currentLine As String, quoteCount As Long
    Dim filePath As String, newCSV As String, folder As String, fileName As String
    
    folder = ThisWorkbook.Path & "\"
    fileName = Dir(folder & "*.csv")
    If fileName = "" Then Exit Sub
    filePath = folder & fileName
    newCSV = folder & "report.csv"
    
    Set fso = CreateObject("Scripting.Filesystemobject")
    Set tsIn = fso.OpenTextFile(filePath, 1, , -1) ' 最后一个参数-1对应UTF-8编码，可按需调整
    Set tsOut = fso.CreateTextFile(newCSV, 1, True)
    
    currentLine = ""
    quoteCount = 0
    Do While Not tsIn.AtEndOfStream
        s = tsIn.ReadLine
        ' 统计当前片段的双引号数量
        quoteCount = quoteCount + (Len(s) - Len(Replace(s, """", "")))
        currentLine = currentLine & s
        If quoteCount Mod 2 = 0 Then
            ' 引号配对，是完整行，写入后重置状态
            tsOut.WriteLine currentLine
            currentLine = ""
            quoteCount = 0
        Else
            ' 引号未配对，换行是字段内异常换行，替换为空格后继续拼接
            currentLine = currentLine & " "
        End If
    Loop
    tsIn.Close
    tsOut.Close
    
    ' 可选：替换原文件，不需要可注释该行
    Kill filePath
    Name newCSV As filePath
End Sub

内容的提问来源于stack exchange，提问作者giannisJS