使用宏导入CSV时忽略回车/换行符及适配可变文件名求助

• 手动通过「数据>获取数据>自文本/CSV」导入含CR（回车符）/LB（换行符）的CSV时，格式正常，内嵌换行符会被正确识别并保留在单元格内；
• 自行编写的ImportCSV宏（基于QueryTable）导入时，内嵌换行符会被当作行分隔符，导致数据错位；
• 录制的Power Query宏仅支持固定路径文件，无法动态选择任意CSV文件。

原ImportCSV宏问题分析 #

传统QueryTable对CSV内嵌换行符的处理逻辑与Power Query不一致，即使设置了双引号文本限定符，也无法正确识别引号包裹的换行内容，导致数据拆分错误。

Sub ImportCSV()

flName = Application.GetOpenFilename("CSV files (*.csv),*.csv, All Files (*.*),*.*")

If flName = "False" Then Exit Sub

flName = "TEXT;" & flName

With ActiveSheet.QueryTables.Add(Connection:=flName, Destination:=Range("A2"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .AdjustColumnWidth = False 
        .RefreshStyle = xlOverwriteCells 
        .Refresh BackgroundQuery:=False 
End With
 
End Sub

录制的InputCSV宏局限性 #

录制的宏硬编码了文件路径、列数和固定列类型，无法适配不同的CSV文件，需要修改为支持动态选择文件的通用版本。

Sub InputCSV()
'
' InputCSV Macro
'
' Keyboard Shortcut: Ctrl+t
'
    ActiveWorkbook.Queries.Add Name:="ExampleFileCSV", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(File.Contents(""D:\ExampleFileCSV.csv""),[Delimiter="""", Columns=17, Encoding=65001, QuoteStyle=QuoteStyle.Csv])," & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Submission Date"", type date}, {""First Name"", type text}" & _
        ", {""Last Name"", type text}, {""Director/Tech ***Staff Only***"", type text}, {""Instrument/Colorguard"", type text}, {""Student Cell Phone Number"", type text}, {""Student Email "", type text}, {""Parent Email"", type text}, {""Monday, July 22nd (Whataburger)"", type text}, {""Tuesday, July 23 (Chick Fil A)"", type text}, {""Image Picker"", type text}, {""Thursday" & _
        ", July 25 (Marco's Pizza)"", type text}, {""Friday, July 26th (Smokey Mo's)"", type text}, {""Image Picker_1"", type text}, {""Saturday, July 27 (Marco's)"", type text}, {""Subtotal"", Int64.Type}, {""Total"", 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=ExampleFileCSV;Extended Properties="""""
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [ExampleFileCSV]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "ExampleFileCSV"
        .Refresh BackgroundQuery:=False
    End With
    Application.CommandBars("Queries and Connections").Visible = False
End Sub

解决方案：通用Power Query导入宏 #

基于录制的宏修改，加入文件选择逻辑，动态替换Power Query公式中的文件路径，同时保留自动适配CSV结构的能力。

修改后的宏代码 #

Sub ImportCSV_PowerQuery()
    Dim flName As Variant
    Dim queryName As String
    Dim pqFormula As String
    
    ' 弹出文件选择对话框，让用户选择目标CSV
    flName = Application.GetOpenFilename("CSV files (*.csv),*.csv, All Files (*.*),*.*")
    If flName = False Then Exit Sub
    
    ' 生成唯一查询名，避免重复添加查询报错
    queryName = "CSV_Import_" & Format(Now(), "YYYYMMDD_HHMMSS")
    
    ' 构建Power Query公式，动态替换文件路径，自动识别列类型
    pqFormula = "let" & vbCrLf & _
        "    Source = Csv.Document(File.Contents(""" & flName & """),[Delimiter="","", Encoding=65001, QuoteStyle=QuoteStyle.Csv])," & vbCrLf & _
        "    #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & vbCrLf & _
        "    #""Auto Detected Column Types"" = Table.AutoDetectColumnTypes(#""Promoted Headers"", [Culture=""zh-CN""])" & vbCrLf & _
        "in" & vbCrLf & _
        "    #""Auto Detected Column Types"""
    
    ' 将查询添加到当前工作簿
    ActiveWorkbook.Queries.Add Name:=queryName, Formula:=pqFormula
    
    ' 在新工作表加载查询数据
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName & ";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & queryName & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = queryName
        .Refresh BackgroundQuery:=False
    End With
    
    ' 隐藏查询和连接面板（可选操作）
    Application.CommandBars("Queries and Connections").Visible = False
End Sub

关键修改点 #

• 动态文件选择：加入Application.GetOpenFilename实现用户自主选择CSV文件，替换硬编码路径；
• 唯一查询名：用时间戳生成查询名，避免重复添加查询导致的报错；
• 自动类型识别：用Table.AutoDetectColumnTypes替代固定列类型转换，适配不同CSV的结构差异；
• 参数化引用：所有涉及查询名的位置使用变量，确保逻辑统一。

注意事项 #

• 如果CSV编码不是UTF-8（对应参数65001），可修改Encoding参数（如GB2312对应936）；
• 若不需要自动识别列类型，可删除#""Auto Detected Column Types""步骤，直接返回#""Promoted Headers""；
• 需确保Excel已启用Power Query功能（Excel 2016及以上版本默认启用）。

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