xls文件批量转csv文件(当前目录下) --VBA

Option Explicit

Sub hj()
Dim cFile$, cPath$, Sh As Worksheet, nRow%
Dim fullfile$
On Error GoTo error

Application.ScreenUpdating = False
Application.EnableEvents = False
    cPath = ThisWorkbook.Path & "\"
    cFile = Dir(cPath & "*.xls")    ' 找寻第一个文件
  

    Do While cFile <> ThisWorkbook.Name    ' 开始循环。
      
        fullfile = cPath & Left(cFile, InStrRev(cFile, ".") - 1) & ".csv"
        
        
        Workbooks.Open cPath & cFile '打开文件
        ActiveWorkbook.SaveAs Filename:=fullfile, FileFormat:=xlCSV, CreateBackup:=True
           '2016.xlsm   (Fileformat:=xlCSV)
        ActiveWorkbook.Close  '关闭文件
      
        cFile = Dir    ' 查找下一个文件
        
    Loop

Application.EnableEvents = True
Application.ScreenUpdating = True
error:
Exit Sub

End Sub