本地文件夹CSV列重排VBA代码崩溃、未生效问题求助

核心问题分析 #

1. 路径逻辑错误：原代码将通配符*csv直接写在fileDirectory中，导致拼接后的文件路径无效（例如C:\...\*csvtest.csv），Dir函数无法正确遍历所有CSV文件，陷入无限循环重复处理第一个文件，最终引发Excel崩溃。
2. 循环未推进：Do Loop中没有调用fileName = Dir()获取下一个文件，循环永远不会终止。
3. 未处理文件保存关闭：打开文件后未保存修改也未关闭，大量文件同时占用内存，既导致崩溃又无法保留修改。
4. 列操作不严谨：CSV以文本格式打开时，列插入操作最好明确移位方向，避免潜在兼容性问题。

修复后的完整代码 #

Option Explicit

Sub FleetMoveColumns()
    Dim fileDirectory As String
    Dim fileName As String
    Dim fileToOpen As Workbook
    
    ' 关闭Excel冗余功能，提升处理效率
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    ' 设置目标文件夹路径（必须以反斜杠结尾）
    fileDirectory = "C:\...\"
    ' 获取第一个CSV文件
    fileName = Dir(fileDirectory & "*.csv")
    
    Do While Len(fileName) > 0
        ' 打开CSV文件，适配本地区域设置避免分隔符错误
        Set fileToOpen = Workbooks.Open(Filename:=fileDirectory & fileName, Local:=True)
        
        ' 剪切R列并插入到AB列位置（明确向右移位）
        Columns("R").Cut
        Columns("AB").Insert Shift:=xlToRight
        
        ' 保存修改并关闭文件
        fileToOpen.Save
        fileToOpen.Close SaveChanges:=False
        
        Debug.Print "已处理文件：" & fileName
        
        ' 获取下一个文件，推进循环
        fileName = Dir()
    Loop
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

关键注意事项 #

• 确保fileDirectory路径末尾添加反斜杠\，否则路径拼接会出错。
• Local:=True参数用于适配系统区域设置，防止CSV文件打开时分隔符（如逗号/分号）识别错误。
• 关闭DisplayAlerts和EnableEvents可避免处理过程中弹出提示框，确保流程自动执行。

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