【转载】Excel2016使用宏批量将xls或xlsx转成csv文件

点击菜单栏中的宏，创建一个宏，粘贴后附代码，然后运行getcsv这个宏，会跳出一个窗口，选择所有你要转化的xls文件。点击运行。

选中以后，等一段时间，再回到xls文件下，会多一个csv文件夹，里面就是我们要导入R的文本文件了。如果要转换的是xlsx文件，把代码中的xls改成xlsx即可。

Sub getCSV()
'这是网上看到的xlsx批量转化，而改写的一个xlsx批量转化csv格式
'1)批量转化csv参考：http://club.excelhome.net/thread-1036776-2-1.html
'2)创建文件夹参考：http://jingyan.baidu.com/article/f54ae2fcdc79bc1e92b8491f.html
'这里设置屏幕不动，警告忽略
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim data As Workbook
'这里用GetOpenFilename弹出一个多选窗口，选中我们要转化成csv的xlsx文件，
file = Application.GetOpenFilename(MultiSelect:=True)
'用LBound和UBound
For i = LBound(file) To UBound(file)
    Workbooks.Open Filename:=file(i)
    Set data = ActiveWorkbook
    Path = data.Path
    '这里设置要保存在目录下面的csv文件夹里,之后可以自己调
    '参考了里面的第一种方法
    On Error Resume Next
    VBA.MkDir (Path & "\csv")
    With data
        .SaveAs Path & "\csv\" & Replace(data.Name, ".xlsx", ".csv"), xlCSV
        .Close True
      End With
Next i
'弹出对话框表示转化已完成，这时去相应地方的csv里查看即可
MsgBox "已转换了" & (i-1) & "个文档"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

再加上xls转xlsx的代码

Sub xls2xlsx()
Dim FilePath, MyFile, iPath, Name, OutPath As String
iPath = ThisWorkbook.Path
OutPath = Dir(iPath & "\xlsx", vbDirectory)
If OutPath = "" Then
    MkDir (iPath & "\xlsx")
End If
MyFile = Dir(iPath & "\*.xls")

If MyFile <> "" Then
Do
    On Error Resume Next
    If MyFile = ThisWorkbook.Name Then MyFile = Dir
    Workbooks.Open (iPath & "\" & MyFile)
    MyFile = Replace(MyFile, ".xls", ".xlsx")
    Name = "\" & MyFile
    FilePath = iPath & "\xlsx" & Name
    Application.ScreenUpdating = False
    ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Workbooks(MyFile).Close True
    Application.ScreenUpdating = True
    MyFile = Dir
Loop While MyFile <> ""
End If
End Sub