批量将Excel文件转CSV

公司刚接了个大单，上千个客户资料，每个客户一个Excel文件，现在要全部转成CSV格式，好方便导入系统批量打印客户卡片。你默默打开第一个文件，点“另存为”，选CSV，保存……然后第二个，第三个……搞了不到100个，手就开始抽筋，眼睛都花了，心里无数个“点算”？（怎么办）

其实，这种重复劳动完全可以让电脑自己搞掂！今天就教你一段VBA代码，一键批量转换，让你瞬时间就搞定所有文件。

代码逻辑，简单讲一讲

这段代码就像一个勤劳的小秘书，它做这几件事：

1. 1. 问你两个问题：先弹个窗口让你选“放Excel的文件夹”，再弹个窗口让你选“保存CSV的文件夹”。就像你告诉它：原材料在这里，成品放那里。
2. 2. 自动扫描干活：它会把源文件夹里所有 .xlsx 和 .xls 文件找出来，一个个打开，把第一个工作表（默认是Sheet1）保存成CSV。如果目标文件夹已经有同名文件，它会聪明地给新文件加个编号，比如 客户资料_1.csv，绝不会覆盖你原来的文件。
3. 3. 干完活汇报：全部搞定后弹个窗告诉你“一共处理了多少个文件”，清清楚楚。

整个过程全自动，你只需要最开始选两个文件夹，剩下就交给它。

完整代码（直接复制就能用）

把下面这段代码复制到VBA编辑器（按Alt+F11打开，插入-模块），然后运行宏ConvertExcelToCSV就行。

Option ExplicitSub ConvertExcelToCSV()    Dim fdSrc As FileDialog    Dim fdDest As FileDialog    Dim srcFolder As String    Dim destFolder As String    Dim fileName As String    Dim wb As Workbook    Dim baseName As String    Dim destPath As String    Dim fileCount As Long    Dim i As Integer    Set fdSrc = Application.FileDialog(4)    With fdSrc        .Title = "请选择包含 Excel 文件的源文件夹"        .AllowMultiSelect = False        If .Show = -1 Then            srcFolder = .SelectedItems(1)        Else            MsgBox "未选择源文件夹，操作取消。", vbExclamation            Exit Sub        End If    End With    Set fdDest = Application.FileDialog(4)    With fdDest        .Title = "请选择保存 CSV 文件的目标文件夹"        .AllowMultiSelect = False        If .Show = -1 Then            destFolder = .SelectedItems(1)        Else            MsgBox "未选择目标文件夹，操作取消。", vbExclamation            Exit Sub        End If    End With    If Right(srcFolder, 1) <> "\" Then srcFolder = srcFolder & "\"    If Right(destFolder, 1) <> "\" Then destFolder = destFolder & "\"    Application.ScreenUpdating = False    Application.DisplayAlerts = False    Application.EnableEvents = False    fileCount = 0    fileName = Dir(srcFolder & "*.xlsx")    Do While fileName <> ""        If ConvertOneFile(srcFolder & fileName, destFolder) Then            fileCount = fileCount + 1        End If        fileName = Dir()    Loop    fileName = Dir(srcFolder & "*.xls")    Do While fileName <> ""        If ConvertOneFile(srcFolder & fileName, destFolder) Then            fileCount = fileCount + 1        End If        fileName = Dir()    Loop    Application.ScreenUpdating = True    Application.DisplayAlerts = True    Application.EnableEvents = True    If fileCount > 0 Then        MsgBox "转换完成！共处理 " & fileCount & " 个文件。", vbInformation    Else        MsgBox "未找到任何 .xlsx 或 .xls 文件。", vbExclamation    End If    Set fdSrc = Nothing    Set fdDest = NothingEnd SubPrivate Function ConvertOneFile(ByVal srcFullPath As String, ByVal destFolder As String) As Boolean    Dim wb As Workbook    Dim baseName As String    Dim destPath As String    Dim i As Integer    Dim ext As String    On Error Resume Next    Set wb = Workbooks.Open(Filename:=srcFullPath, ReadOnly:=True, AddToMRU:=False)    If Err.Number <> 0 Or wb Is Nothing Then        On Error GoTo 0        ConvertOneFile = False        Exit Function    End If    On Error GoTo 0    wb.Sheets(1).Activate    baseName = Left(srcFullPath, InStrRev(srcFullPath, ".") - 1)    baseName = Mid(baseName, InStrRev(baseName, "\") + 1)    destPath = destFolder & baseName & ".csv"    i = 1    Do While Dir(destPath) <> ""        destPath = destFolder & baseName & "_" & i & ".csv"        i = i + 1    Loop    On Error Resume Next    wb.SaveAs Filename:=destPath, FileFormat:=xlCSV, CreateBackup:=False    If Err.Number <> 0 Then        On Error GoTo 0        wb.Close SaveChanges:=False        ConvertOneFile = False        Exit Function    End If    On Error GoTo 0    wb.Close SaveChanges:=False    ConvertOneFile = TrueEnd Function

使用小贴士

• • 代码只转换第一个工作表，如果你有其他需求，可以稍微改改。
• • 转换后的CSV文件编码和Excel默认一样，一般够用了。
• • 如果源文件有密码或损坏，它会自动跳过，不影响其他文件。

　　由于公众号推送规则调整，“设为星标” 是确保您能准时收到我们原创内容的最佳方式。

✨ 请您花2秒完成：

1. 点击顶部公众号名称，进入主页。

2. 点击右上角 【…】，选择 【设为星标】。

您的👍 点赞 +转发 + 在看，是对我们持续分享的最大支持！

感谢您阅读至此。

　　为保障账号持续运营与内容创作，文中或文末可能会穿插由平台智能推荐的内容，仅供参考，您可根据自身需求自由选择。我们的核心始终不变：与您一起，每天进步一点！💪

#VBA #EXCEL技巧 #办公自动化