Excel VBA 批量将CSV转为以B1值命名的XLSX代码排错问询

实现需求 #

• 打开指定文件夹下所有.csv格式文件
• 每个文件保存为.xlsx格式副本
• .xlsx文件名取对应csv文件第一个工作表B1单元格的内容

原代码问题定位 #

你编写的代码存在4个核心错误：

1. 变量冗余赋值+拼写隐患：开头声明了MyFolderPath后重复赋值2次，大小写拼写不一致，开启Option Explicit时会直接触发未定义报错
2. 循环逻辑死锁：While循环处理完单个文件后没有调用MyFileName = Dir获取下一个文件名，会一直重复处理第一个CSV文件无法退出循环
3. 保存方法调用错误：SaveCopyAs只能保存和原文件格式一致的副本，无法直接切换为xlsx格式，导出的文件会因为格式不匹配无法打开，需要改用SaveAs方法并指定格式参数
4. 缺少非法字符校验：未处理B1单元格内容为空、包含\/:*?"<>|等文件名禁用字符的场景，会直接触发保存失败

修复后可用代码 #

Sub BatchCsvToXlsx()
    Dim MyFolderPath As String
    Dim MyFileName As String
    Dim CSVWorkbook As Workbook
    Dim SaveName As String
    
    ' 关闭屏幕刷新和告警提升运行效率
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    MyFolderPath = Application.DefaultFilePath
    ' 也可以自定义路径，比如改为 MyFolderPath = "C:\Users\XX\Desktop\待处理CSV"
    MyFileName = Dir(MyFolderPath & "\*.csv")
    
    While MyFileName <> ""
        Set CSVWorkbook = Workbooks.Open(MyFolderPath & "\" & MyFileName)
        
        ' 处理文件名非法字符
        SaveName = CSVWorkbook.Sheets(1).Range("B1").Value
        SaveName = Replace(SaveName, "\", "")
        SaveName = Replace(SaveName, "/", "")
        SaveName = Replace(SaveName, ":", "")
        SaveName = Replace(SaveName, "*", "")
        SaveName = Replace(SaveName, "?", "")
        SaveName = Replace(SaveName, """", "")
        SaveName = Replace(SaveName, "<", "")
        SaveName = Replace(SaveName, ">", "")
        SaveName = Replace(SaveName, "|", "")
        
        ' B1为空时默认使用原CSV文件名前缀
        If SaveName = "" Then SaveName = VBA.Left(MyFileName, Len(MyFileName) - 4)
        
        ' 按指定格式另存
        CSVWorkbook.SaveAs Filename:=MyFolderPath & "\" & SaveName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        
        CSVWorkbook.Close SaveChanges:=False
        ' 获取下一个待处理文件
        MyFileName = Dir
    Wend
    
    ' 恢复系统默认设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "批量转换完成！"
End Sub

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