xls批量转csv

本文为Excel VBA代码，可以实现将某一文件夹内的Excel文件（xls或者xlsx）另存为“逗号分隔的csv文件”。

使用条件：

1. Windows系统；

2. 已安装 MS 2007或以上版本

本文测试环境：  Win7 sp1 64bit 英文系统+MS2013

如果菜单栏上没有开发工具，则在选项中添加。点击文件，弹出菜单选择选项。在EXCEL选项中，点击自定义功能区，右边勾选开发工具，然后点击确定。这样开发工具就会显示在菜单栏上。

1.首先新建一个Excel文件，按Alt+F11，打开VBA编辑器，选择Insert-Module, 在编辑器中输入如下代码：

其中，fPath 定义了存放Excel文件的路径，sPath定义了csv文件的输出位置，根据个人情况进行修改，不要忘记路径最后的左斜线。

Sub SaveToCSVs()

    Dim fDir As String

    Dim wB As Workbook

    Dim wS As Worksheet

    Dim fPath As String

    Dim sPath As String

    fPath = "C:\Users\ms-off1\Desktop\temp\"

    sPath = "C:\Users\ms-off1\Desktop\temp\"

    fDir = Dir(fPath)

    Do While (fDir <> "")

        If Right(fDir, 4) = ".xls" Or Right(fDir, 5) = ".xlsx" Then

            On Error Resume Next

            Set wB = Workbooks.Open(fPath & fDir)

            'MsgBox (wB.Name)

            For Each wS In wB.Sheets

                wS.SaveAs sPath & wB.Name & ".csv", xlCSV

            Next wS

            wB.Close False

            Set wB = Nothing

        End If

        fDir = Dir

        On Error GoTo 0

    Loop

End Sub

2.点击VBA编辑器中的Run--> Run Sub/User Form，或者按下F5，开始执行程序。

可以．文件1中有VBA代码操作文件2 文件１可以用Thisworkbook.Path来确认路径．

Thisworkbook.Path可以获得当前宏所在路径

Sub SaveToCSVs()
    Dim fDir As String
    Dim fileName As String
    Dim wB As Workbook
    Dim wS As Worksheet
    Dim fPath As String
    Dim sPath As String
    fPath = ThisWorkbook.Path & "\xls\"
    sPath = ThisWorkbook.Path & "\csv\"
    fDir = Dir(fPath)
    Do While (fDir <> "")
        If Right(fDir, 4) = ".xls" Or Right(fDir, 5) = ".xlsx" Then
            On Error Resume Next
            Set wB = Workbooks.Open(fPath & fDir)
            
            If Right(fDir, 4) = ".xls" Then
                fileName = Left(wB.Name, Len(wB.Name) - 4)
            End If
            If Right(fDir, 5) = ".xlsx" Then
                fileName = Left(wB.Name, Len(wB.Name) - 5)
            End If
            
            wB.SaveAs sPath & fileName & ".csv"
            
            'MsgBox (wB.Name)
            'For Each wS In wB.Sheets
               'wS.SaveAs sPath & fileName & ".csv", xlCSV
            'Next wS
            
            wB.Close False
            Set wB = Nothing
        End If
        fDir = Dir
        On Error GoTo 0
    Loop
End Sub